From e8beabc99a5d6d62c0e23dadbc354defcff7f1cd Mon Sep 17 00:00:00 2001
From: Ivo Gabe de Wolff <ivogabe@ivogabe.nl>
Date: Mon, 10 Oct 2022 16:56:53 +0200
Subject: [PATCH 01/62] Fix issue of invalidating after writing to buffer

---
 .../Accelerate/Trafo/Operation/Simplify.hs    | 69 ++++++++-----------
 .../Accelerate/Trafo/WeakenedEnvironment.hs   |  8 +--
 2 files changed, 34 insertions(+), 43 deletions(-)

diff --git a/src/Data/Array/Accelerate/Trafo/Operation/Simplify.hs b/src/Data/Array/Accelerate/Trafo/Operation/Simplify.hs
index 5b2e76fde..06c894b4b 100644
--- a/src/Data/Array/Accelerate/Trafo/Operation/Simplify.hs
+++ b/src/Data/Array/Accelerate/Trafo/Operation/Simplify.hs
@@ -346,46 +346,37 @@ bindingEnv outputs (LeftHandSideWildcard _) (Exec op args)      env = foldl' add
         markCopy _ = (InfoBuffer Nothing Nothing [output])
 bindingEnv _ lhs _ env = bindEnv lhs env
 
-invalidate :: IdxSet env -> InfoEnv env -> InfoEnv env
-invalidate indices (InfoEnv env1) = InfoEnv env4
+-- Updates the InfoEnv, with the information that the buffers in 'indices' may
+-- have been updated. This breaks the 'is-copy-of' relation between buffers.
+invalidate :: forall env. IdxSet env -> InfoEnv env -> InfoEnv env
+invalidate indices infoEnv@(InfoEnv env1) =
+  InfoEnv
+    $ wupdateSetWeakened dropCopyTo indicesCopiesOf
+    $ wupdateSetWeakened dropCopyOf indicesCopiedTo
+    $ wremoveSet InfoNone indices' env1
   where
-    -- Drops the given indices from the InfoEnv, unless they are an alias
-    -- (InfoAlias). Those are not removed, but instead the info on the
-    -- variable of which they are an alias is removed.
-    -- Returns a list of removed Infos.
-    goDrop :: IdxSet env -> WEnv Info env -> (WEnv Info env, [Exists (Info env)])
-    goDrop indices' e1
-      | [] <- indices'' = (e2, dropped')
-      | otherwise = (dropped' ++) <$> goDrop (IdxSet.fromList indices'') e2
-      where
-        (infos, e2) = wupdatePrjSet update indices' e1
-        (indices'', dropped') = partitionEithers $ map splitAlias infos
-
-        update :: Info env t -> Info env t
-        update i@(InfoAlias _) = i -- Keep aliasses
-        update _ = InfoNone
-
-        splitAlias :: Exists (Info env) -> Either (Exists (Idx env)) (Exists (Info env))
-        splitAlias (Exists (InfoAlias idx)) = Left $ Exists idx
-        splitAlias (Exists i) = Right $ Exists i
-
-    (env2, dropped) = goDrop indices env1
-    invalidatedCopies = dropped >>= \(Exists i) -> Exists <$> copiedTo i
-    invalidatedCopiedFrom = dropped >>= \case
-      Exists (InfoBuffer _ (Just idx) _) -> [Exists idx]
-      _ -> []
-    -- Remove copies of modified buffers
-    env3 = wremoveSet InfoNone (IdxSet.fromList invalidatedCopies) env2
-    -- The 'is-copy-of' relation is stored on both sides. If a copy is changed
-    -- we must thus update the Info stored in the original buffer to remove the
-    -- link between these buffers.
-    env4 = wupdateSetWeakened
-            (\k -> \case
-              InfoBuffer unitScalar copyOf copiedTo' -> InfoBuffer unitScalar copyOf $ filter (\idx -> k >:> idx `IdxSet.member` indices) copiedTo'
-              i -> i
-            )
-            (IdxSet.fromList invalidatedCopiedFrom)
-            env3
+    indices' :: IdxSet env
+    indices' = IdxSet.map (weaken $ substituteOutput infoEnv) indices
+
+    findCopies :: Exists (Idx env) -> (IdxSet env, IdxSet env)
+    findCopies (Exists idx) = case infoFor idx infoEnv of
+      InfoAlias idx' -> internalError "Alias should be substituted already"
+      InfoBuffer _ (Just idx') copies -> (IdxSet.singleton idx', IdxSet.fromList' copies)
+      _ -> (IdxSet.empty, IdxSet.empty)
+
+    (indicesCopiesOf', indicesCopiedTo') = unzip $ map findCopies $ IdxSet.toList indices'
+    indicesCopiesOf = IdxSet.unions indicesCopiesOf'
+    indicesCopiedTo = IdxSet.unions indicesCopiedTo'
+
+    -- Forgets that this buffer is a copy of a buffer in indices'.
+    dropCopyOf :: env' :> env -> Info env' t -> Info env' t
+    dropCopyOf _ (InfoBuffer unitScalar _ c)
+      = InfoBuffer unitScalar Nothing c
+
+    -- Forgets that this buffer is copied to buffers in indices'
+    dropCopyTo :: env' :> env -> Info env' t -> Info env' t
+    dropCopyTo k (InfoBuffer unitScalar copyOf copiedTo')
+      = InfoBuffer unitScalar copyOf $ filter (\idx -> not $ k >:> idx `IdxSet.member` indices) copiedTo'
 
 outputArrays :: Args env args -> IdxSet env
 outputArrays = IdxSet.fromList . mapMaybe f . argsVars
diff --git a/src/Data/Array/Accelerate/Trafo/WeakenedEnvironment.hs b/src/Data/Array/Accelerate/Trafo/WeakenedEnvironment.hs
index fb9b1f385..0ad15cafd 100644
--- a/src/Data/Array/Accelerate/Trafo/WeakenedEnvironment.hs
+++ b/src/Data/Array/Accelerate/Trafo/WeakenedEnvironment.hs
@@ -98,10 +98,10 @@ wremoveSet nil (IdxSet set) env = go set env
     go :: PartialEnv g env' -> WEnv' f env1 env' -> WEnv' f env1 env'
     go PEnd        e             = e
     go p           (WWeaken k e) = WWeaken k $ go p e
-    go (PNone p)   (WPushA e _)  = WPushA (go p e) nil
-    go (PNone p)   (WPushB e _)  = WPushB (go p e) nil
-    go (PPush p _) (WPushA e f)  = WPushA (go p e) f
-    go (PPush p _) (WPushB e f)  = WPushB (go p e) f
+    go (PNone p)   (WPushA e f)  = WPushA (go p e) f
+    go (PNone p)   (WPushB e f)  = WPushB (go p e) f
+    go (PPush p _) (WPushA e _)  = WPushA (go p e) nil
+    go (PPush p _) (WPushB e _)  = WPushB (go p e) nil
 
 wupdatePrjSet :: forall f env. Sink f => (forall env' t. f env' t -> f env' t) -> IdxSet env -> WEnv f env -> ([Exists (f env)], WEnv f env)
 wupdatePrjSet update (IdxSet set) env = go weakenId set env

From 901b526d68e8cd54169578b818b55039261773ba Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Tue, 7 Feb 2023 13:51:32 +0100
Subject: [PATCH 02/62] build fix for ghc-9.2

---
 src/Data/Array/Accelerate/AST/Idx.hs | 13 +++++++++----
 stack-9.2.yaml                       |  7 ++-----
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/Data/Array/Accelerate/AST/Idx.hs b/src/Data/Array/Accelerate/AST/Idx.hs
index 548453e2b..cd3c8c556 100644
--- a/src/Data/Array/Accelerate/AST/Idx.hs
+++ b/src/Data/Array/Accelerate/AST/Idx.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE CPP                 #-}
 {-# LANGUAGE EmptyCase           #-}
 {-# LANGUAGE GADTs               #-}
+{-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE PatternSynonyms     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -31,11 +32,12 @@ module Data.Array.Accelerate.AST.Idx (
 
 ) where
 
-import Language.Haskell.TH.Extra
+import Data.Kind
+import Language.Haskell.TH.Extra                                    hiding ( Type )
 
 #ifndef ACCELERATE_INTERNAL_CHECKS
-import Data.Type.Equality ((:~:)(Refl))
-import Unsafe.Coerce (unsafeCoerce)
+import Data.Type.Equality                                           ( (:~:)(Refl) )
+import Unsafe.Coerce                                                ( unsafeCoerce )
 #endif
 
 
@@ -72,7 +74,8 @@ liftIdx (SuccIdx ix) = [|| SuccIdx $$(liftIdx ix) ||]
 --
 -- For performance, it uses an Int under the hood.
 --
-newtype Idx env t = UnsafeIdxConstructor { unsafeRunIdx :: Int }
+newtype Idx :: Type -> Type -> Type where
+  UnsafeIdxConstructor :: { unsafeRunIdx :: Int } -> Idx env t
 
 {-# COMPLETE ZeroIdx, SuccIdx #-}
 
@@ -108,6 +111,8 @@ liftIdx (UnsafeIdxConstructor i) = [|| UnsafeIdxConstructor i ||]
 pattern VoidIdx :: forall env t a. (env ~ ()) => () => a -> Idx env t
 pattern VoidIdx a <- (\case{} -> a)
 
+{-# COMPLETE VoidIdx #-}
+
 data PairIdx p a where
   PairIdxLeft  :: PairIdx (a, b) a
   PairIdxRight :: PairIdx (a, b) b
diff --git a/stack-9.2.yaml b/stack-9.2.yaml
index 69365d734..d3a501d74 100644
--- a/stack-9.2.yaml
+++ b/stack-9.2.yaml
@@ -2,15 +2,12 @@
 # For advanced use and comprehensive documentation of the format, please see:
 # https://docs.haskellstack.org/en/stable/yaml_configuration/
 
-compiler: ghc-9.2.1
-resolver: nightly-2022-02-19
+resolver: lts-20.10
 
 packages:
 - .
 
-extra-deps:
-- base-compat-0.12.1
-- doctest-0.20.0
+# extra-deps: []
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

From 91850b4b11894c734c3887d36db8aeacb9e74d73 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Tue, 7 Feb 2023 13:52:22 +0100
Subject: [PATCH 03/62] build fix for ghc-9.4

---
 .github/workflows/ci-linux.yml                |  1 +
 .github/workflows/ci-macos.yml                |  1 +
 .github/workflows/ci-windows.yml              |  1 +
 accelerate.cabal                              |  2 +-
 src/Data/Array/Accelerate.hs                  |  1 +
 src/Data/Array/Accelerate/AST/LeftHandSide.hs |  1 +
 src/Data/Array/Accelerate/Array/Data.hs       |  3 +-
 src/Data/Array/Accelerate/Array/Remote/LRU.hs |  1 +
 src/Data/Array/Accelerate/Async.hs            |  8 +++++
 src/Data/Array/Accelerate/Classes/RealFrac.hs |  1 +
 src/Data/Array/Accelerate/Data/Complex.hs     |  5 +++
 src/Data/Array/Accelerate/Language.hs         |  4 +++
 src/Data/Array/Accelerate/Prelude.hs          |  3 ++
 src/Data/Array/Accelerate/Sugar/Vec.hs        |  5 +--
 stack-9.4.yaml                                | 36 +++++++++++++++++++
 15 files changed, 69 insertions(+), 4 deletions(-)
 create mode 100644 stack-9.4.yaml

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index b3258a84a..f37834422 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -20,6 +20,7 @@ jobs:
       fail-fast: false
       matrix:
         ghc:
+          - "9.4"
           - "9.2"
           - "9.0"
           - "8.10"
diff --git a/.github/workflows/ci-macos.yml b/.github/workflows/ci-macos.yml
index f3e83e266..a96e9f424 100644
--- a/.github/workflows/ci-macos.yml
+++ b/.github/workflows/ci-macos.yml
@@ -20,6 +20,7 @@ jobs:
       fail-fast: false
       matrix:
         ghc:
+          - "9.4"
           - "9.2"
           - "9.0"
           - "8.10"
diff --git a/.github/workflows/ci-windows.yml b/.github/workflows/ci-windows.yml
index 03f066140..eb9889ffc 100644
--- a/.github/workflows/ci-windows.yml
+++ b/.github/workflows/ci-windows.yml
@@ -20,6 +20,7 @@ jobs:
       fail-fast: false
       matrix:
         ghc:
+          - "9.4"
           - "9.2"
           - "9.0"
           - "8.10"
diff --git a/accelerate.cabal b/accelerate.cabal
index 118210a38..8979f913e 100644
--- a/accelerate.cabal
+++ b/accelerate.cabal
@@ -332,7 +332,7 @@ flag nofib
 
 library
   build-depends:
-          base                          >= 4.12 && < 4.17
+          base                          >= 4.12 && < 4.18
         , ansi-terminal                 >= 0.6.2
         , base-orphans                  >= 0.3
         , bytestring                    >= 0.10.2
diff --git a/src/Data/Array/Accelerate.hs b/src/Data/Array/Accelerate.hs
index ff1729f27..2b869d74a 100644
--- a/src/Data/Array/Accelerate.hs
+++ b/src/Data/Array/Accelerate.hs
@@ -472,6 +472,7 @@ import GHC.Stack
 
 -- $setup
 -- >>> :seti -XTypeOperators
+-- >>> import Data.Array.Accelerate
 -- >>> import Data.Array.Accelerate.Interpreter
 -- >>> :{
 --   let runExp :: Elt e => Exp e -> e
diff --git a/src/Data/Array/Accelerate/AST/LeftHandSide.hs b/src/Data/Array/Accelerate/AST/LeftHandSide.hs
index bf11e3dda..994cd9e6f 100644
--- a/src/Data/Array/Accelerate/AST/LeftHandSide.hs
+++ b/src/Data/Array/Accelerate/AST/LeftHandSide.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes      #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators   #-}
 {-# OPTIONS_HADDOCK hide #-}
 -- |
 -- Module      : Data.Array.Accelerate.AST.LeftHandSide
diff --git a/src/Data/Array/Accelerate/Array/Data.hs b/src/Data/Array/Accelerate/Array/Data.hs
index a22475bce..3885d0b4e 100644
--- a/src/Data/Array/Accelerate/Array/Data.hs
+++ b/src/Data/Array/Accelerate/Array/Data.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE UnboxedTuples        #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_HADDOCK hide #-}
@@ -73,8 +74,8 @@ import Foreign.ForeignPtr
 import Foreign.Storable
 import Formatting                                                   hiding ( bytes )
 import Language.Haskell.TH.Extra                                    hiding ( Type )
-import Prelude                                                      hiding ( mapM )
 import System.IO.Unsafe
+import Prelude                                                      hiding ( mapM )
 
 import GHC.Exts                                                     hiding ( build )
 import GHC.ForeignPtr
diff --git a/src/Data/Array/Accelerate/Array/Remote/LRU.hs b/src/Data/Array/Accelerate/Array/Remote/LRU.hs
index 6c9852269..e9d26c0c9 100644
--- a/src/Data/Array/Accelerate/Array/Remote/LRU.hs
+++ b/src/Data/Array/Accelerate/Array/Remote/LRU.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeOperators       #-}
 {-# OPTIONS_HADDOCK hide #-}
 -- |
 -- Module      : Data.Array.Accelerate.Array.Remote.LRU
diff --git a/src/Data/Array/Accelerate/Async.hs b/src/Data/Array/Accelerate/Async.hs
index c7a7aae2c..b21fd822a 100644
--- a/src/Data/Array/Accelerate/Async.hs
+++ b/src/Data/Array/Accelerate/Async.hs
@@ -91,13 +91,21 @@ cancel (Async tid _) = throwTo tid ThreadKilled
 --
 {-# INLINE rawForkIO #-}
 rawForkIO :: IO () -> IO ThreadId
+#if __GLASGOW_HASKELL__ < 904
 rawForkIO action = IO $ \s ->
+#else
+rawForkIO (IO action) = IO $ \s ->
+#endif
   case fork# action s of
     (# s', tid #) -> (# s', ThreadId tid #)
 
 {-# INLINE rawForkOn #-}
 rawForkOn :: Int -> IO () -> IO ThreadId
+#if __GLASGOW_HASKELL__ < 904
 rawForkOn (I# cpu) action = IO $ \s ->
+#else
+rawForkOn (I# cpu) (IO action) = IO $ \s ->
+#endif
   case forkOn# cpu action s of
     (# s', tid #) -> (# s', ThreadId tid #)
 
diff --git a/src/Data/Array/Accelerate/Classes/RealFrac.hs b/src/Data/Array/Accelerate/Classes/RealFrac.hs
index 9a12e5029..4cec0fde9 100644
--- a/src/Data/Array/Accelerate/Classes/RealFrac.hs
+++ b/src/Data/Array/Accelerate/Classes/RealFrac.hs
@@ -275,3 +275,4 @@ preludeError x
             , "These Prelude.RealFrac instances are present only to fulfil superclass"
             , "constraints for subsequent classes in the standard Haskell numeric hierarchy."
             ]
+
diff --git a/src/Data/Array/Accelerate/Data/Complex.hs b/src/Data/Array/Accelerate/Data/Complex.hs
index 1a1c46767..1ac4ba771 100644
--- a/src/Data/Array/Accelerate/Data/Complex.hs
+++ b/src/Data/Array/Accelerate/Data/Complex.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
@@ -9,6 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE TypeSynonymInstances  #-}
 {-# LANGUAGE UndecidableInstances  #-}
 {-# LANGUAGE ViewPatterns          #-}
@@ -67,6 +69,9 @@ import Data.Complex                                                 ( Complex(..
 import Prelude                                                      ( ($) )
 import qualified Data.Complex                                       as C
 import qualified Prelude                                            as P
+#if __GLASGOW_HASKELL__ >= 904
+import Data.Type.Equality
+#endif
 
 
 infix 6 ::+
diff --git a/src/Data/Array/Accelerate/Language.hs b/src/Data/Array/Accelerate/Language.hs
index 727e9f7b9..5d3ca5004 100644
--- a/src/Data/Array/Accelerate/Language.hs
+++ b/src/Data/Array/Accelerate/Language.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ConstraintKinds     #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
@@ -119,6 +120,9 @@ import Data.Array.Accelerate.Classes.Num
 import Data.Array.Accelerate.Classes.Ord
 
 import Prelude                                                      ( ($), (.), Maybe(..), Char )
+#if __GLASGOW_HASKELL__ >= 904
+import Data.Type.Equality
+#endif
 
 
 -- $setup
diff --git a/src/Data/Array/Accelerate/Prelude.hs b/src/Data/Array/Accelerate/Prelude.hs
index 149c46347..a833ad12c 100644
--- a/src/Data/Array/Accelerate/Prelude.hs
+++ b/src/Data/Array/Accelerate/Prelude.hs
@@ -139,6 +139,9 @@ import Data.Array.Accelerate.Data.Bits
 
 import Lens.Micro                                                   ( Lens', (&), (^.), (.~), (+~), (-~), lens, over )
 import Prelude                                                      ( (.), ($), Maybe(..), const, id, flip )
+#if __GLASGOW_HASKELL__ >= 904
+import Data.Type.Equality
+#endif
 
 
 -- $setup
diff --git a/src/Data/Array/Accelerate/Sugar/Vec.hs b/src/Data/Array/Accelerate/Sugar/Vec.hs
index 723d32c7b..bc49eeb8b 100644
--- a/src/Data/Array/Accelerate/Sugar/Vec.hs
+++ b/src/Data/Array/Accelerate/Sugar/Vec.hs
@@ -1,7 +1,8 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE MagicHash           #-}
 {-# LANGUAGE ConstraintKinds     #-}
+{-# LANGUAGE MagicHash           #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
 {-# OPTIONS_HADDOCK hide #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- |
diff --git a/stack-9.4.yaml b/stack-9.4.yaml
new file mode 100644
index 000000000..55a0a2301
--- /dev/null
+++ b/stack-9.4.yaml
@@ -0,0 +1,36 @@
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+resolver: nightly-2023-02-06
+
+packages:
+- .
+
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.9"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor
+#
+# vim: nospell

From 1775aef2cec1a8e0495d7d0094bb99f8fec0d111 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Tue, 7 Feb 2023 13:52:36 +0100
Subject: [PATCH 04/62] update ci

---
 .github/workflows/ci-linux.yml   | 28 +++++++++++++++++++++-------
 .github/workflows/ci-macos.yml   | 30 ++++++++++++++++++++++--------
 .github/workflows/ci-windows.yml |  6 +++---
 3 files changed, 46 insertions(+), 18 deletions(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index f37834422..3a3864f3e 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -31,16 +31,30 @@ jobs:
       HADDOCK_FLAGS: "--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments=\"--no-print-missing-docs\""
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - run: ln -s stack-${{ matrix.ghc }}.yaml stack.yaml
 
-      - uses: actions/cache@v2
+      - uses: actions/checkout@v3
+        with:
+          repository: actions/cache
+          path: .github/actions/cache-always
+          ref: v3
+
+      # Tweak `action.yml` of `actions/cache@v3` to remove the `post-if`
+      # condition, making it default to `post-if: always ()`.
+      - name: Set up actions/cache-always@v3
+        run: |
+          sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
+
+      - name: actions/cache-always@v3
+        uses: .github/actions/cache-always
         with:
           path: snapshot.pkgdb
           key: ${{ runner.os }}-${{ matrix.ghc }}-snapshot.pkgdb
 
-      - uses: actions/cache@v2
+      - name: actions/cache-always@v3
+        uses: .github/actions/cache-always
         with:
           path: |
             ~/.local/bin
@@ -56,10 +70,10 @@ jobs:
       - name: Install stack
         run: |
           mkdir -p ~/.local/bin
-          if [[ ! -x ~/.local/bin/stack ]]; then
-            curl -sL https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
-            chmod a+x ~/.local/bin/stack
-          fi
+          # if [[ ! -x ~/.local/bin/stack ]]; then
+          #   curl -sL https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+          #   chmod a+x ~/.local/bin/stack
+          # fi
           echo "~/.local/bin" >> $GITHUB_PATH
 
       - name: Install GHC
diff --git a/.github/workflows/ci-macos.yml b/.github/workflows/ci-macos.yml
index a96e9f424..dbf37a521 100644
--- a/.github/workflows/ci-macos.yml
+++ b/.github/workflows/ci-macos.yml
@@ -31,16 +31,30 @@ jobs:
       HADDOCK_FLAGS: "--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments=\"--no-print-missing-docs\""
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - run: ln -s stack-${{ matrix.ghc }}.yaml stack.yaml
 
-      - uses: actions/cache@v2
+      - uses: actions/checkout@v3
+        with:
+          repository: actions/cache
+          path: .github/actions/cache-always
+          ref: v3
+
+      # Tweak `action.yml` of `actions/cache@v3` to remove the `post-if`
+      # condition, making it default to `post-if: always ()`.
+      - name: Set up actions/cache-always@v3
+        run: |
+          sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
+
+      - name: actions/cache-always@v3
+        uses: .github/actions/cache-always
         with:
           path: snapshot.pkgdb
           key: ${{ runner.os }}-${{ matrix.ghc }}-snapshot.pkgdb
 
-      - uses: actions/cache@v2
+      - name: actions/cache-always@v3
+        uses: .github/actions/cache-always
         with:
           path: |
             ~/.local/bin
@@ -56,11 +70,11 @@ jobs:
       - name: Install stack
         run: |
           mkdir -p ~/.local/bin
-          if [[ ! -x ~/.local/bin/stack ]]; then
-            brew install gnu-tar
-            curl -sL https://get.haskellstack.org/stable/osx-x86_64.tar.gz | gtar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
-            chmod a+x ~/.local/bin/stack
-          fi
+          # if [[ ! -x ~/.local/bin/stack ]]; then
+          #   brew install gnu-tar
+          #   curl -sL https://get.haskellstack.org/stable/osx-x86_64.tar.gz | gtar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+          #   chmod a+x ~/.local/bin/stack
+          # fi
           echo "~/.local/bin" >> $GITHUB_PATH
 
       - name: Install GHC
diff --git a/.github/workflows/ci-windows.yml b/.github/workflows/ci-windows.yml
index eb9889ffc..b8fc20cb3 100644
--- a/.github/workflows/ci-windows.yml
+++ b/.github/workflows/ci-windows.yml
@@ -30,16 +30,16 @@ jobs:
       __COMPAT_LAYER: ""
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - run: mv stack-${{ matrix.ghc }}.yaml stack.yaml
 
-      - uses: actions/cache@v2
+      - uses: actions/cache@v3
         with:
           path: snapshot.pkgdb
           key: ${{ runner.os }}-${{ matrix.ghc }}-snapshot.pkgdb
 
-      - uses: actions/cache@v2
+      - uses: actions/cache@v3
         with:
           path: |
             C:\Users\runneradmin\AppData\Roaming\stack

From fd350f8410ff558c9a8b1f8a0b83326db7c76f71 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 11:46:07 +0100
Subject: [PATCH 05/62] update submodule tracy@v0.9

---
 Setup.hs                                      |  2 +-
 accelerate.cabal                              | 49 ++++++++++---------
 cbits/tracy                                   |  2 +-
 .../Array/Accelerate/Debug/Internal/Tracy.hs  | 44 ++++++++++++++---
 4 files changed, 65 insertions(+), 32 deletions(-)

diff --git a/Setup.hs b/Setup.hs
index 46bfa0826..600cb0795 100755
--- a/Setup.hs
+++ b/Setup.hs
@@ -43,7 +43,7 @@ preConfHook args config_flags = do
            then rawSystemExit verbosity "git" ["submodule", "update", "--init", "--recursive"]
            else do
              -- XXX: This must be kept up to date with the git submodule revision
-             let archive = "v0.7.8.tar.gz"
+             let archive = "v0.9.tar.gz"
              createDirectoryIfMissing True "cbits/tracy"
              rawSystemExit verbosity "curl" ["-LO", "https://github.com/wolfpld/tracy/archive/refs/tags/" ++ archive]
              rawSystemExit verbosity "tar" ["-xzf", archive, "-C", "cbits/tracy", "--strip-components", "1"]
diff --git a/accelerate.cabal b/accelerate.cabal
index 8979f913e..3da8b21fe 100644
--- a/accelerate.cabal
+++ b/accelerate.cabal
@@ -144,15 +144,15 @@ extra-source-files:
     cbits/xkcp/*.inc
     -- TRACY
     -- These are referenced directly using the FFI
-    cbits/tracy/*.h
-    cbits/tracy/*.hpp
-    cbits/tracy/*.cpp
-    cbits/tracy/common/*.h
-    cbits/tracy/common/*.hpp
-    cbits/tracy/common/*.cpp
-    cbits/tracy/client/*.h
-    cbits/tracy/client/*.hpp
-    cbits/tracy/client/*.cpp
+    cbits/tracy/public/*.cpp
+    cbits/tracy/public/tracy/*.h
+    cbits/tracy/public/tracy/*.hpp
+    cbits/tracy/public/common/*.h
+    cbits/tracy/public/common/*.hpp
+    cbits/tracy/public/common/*.cpp
+    cbits/tracy/public/client/*.h
+    cbits/tracy/public/client/*.hpp
+    cbits/tracy/public/client/*.cpp
     -- These are used to build Tracy's client tools in Setup.hs
     cbits/tracy/capture/build/unix/Makefile
     cbits/tracy/capture/build/unix/*.mk
@@ -166,32 +166,35 @@ extra-source-files:
     cbits/tracy/profiler/build/win32/Tracy.vcxproj.filters
     -- Used by the Tracy's client tools
     cbits/tracy/capture/src/*.cpp
-    cbits/tracy/imgui/*.h
     cbits/tracy/imgui/*.cpp
-    cbits/tracy/imgui/misc/freetype/*.h
+    cbits/tracy/imgui/*.h
     cbits/tracy/imgui/misc/freetype/*.cpp
-    cbits/tracy/libbacktrace/*.h
-    cbits/tracy/libbacktrace/*.hpp
-    cbits/tracy/libbacktrace/*.cpp
+    cbits/tracy/imgui/misc/freetype/*.h
+    cbits/tracy/nfd/*.cpp
     cbits/tracy/nfd/*.h
-    cbits/tracy/nfd/*.c
+    cbits/tracy/nfd/*.m
+    cbits/tracy/profiler/src/*.cpp
     cbits/tracy/profiler/src/*.h
     cbits/tracy/profiler/src/*.hpp
-    cbits/tracy/profiler/src/*.cpp
-    cbits/tracy/profiler/libs/gl3w/GL/*.h
-    cbits/tracy/profiler/libs/gl3w/GL/*.c
+    cbits/tracy/profiler/src/font/*.hpp
+    cbits/tracy/profiler/src/imgui/*.cpp
+    cbits/tracy/profiler/src/imgui/*.h
+    cbits/tracy/public/libbacktrace/*.cpp
+    cbits/tracy/public/libbacktrace/*.h
+    cbits/tracy/public/libbacktrace/*.hpp
+    cbits/tracy/server/*.cpp
     cbits/tracy/server/*.h
     cbits/tracy/server/*.hpp
-    cbits/tracy/server/*.cpp
     cbits/tracy/zstd/*.h
-    cbits/tracy/zstd/common/*.h
     cbits/tracy/zstd/common/*.c
-    cbits/tracy/zstd/compress/*.h
+    cbits/tracy/zstd/common/*.h
     cbits/tracy/zstd/compress/*.c
-    cbits/tracy/zstd/decompress/*.h
+    cbits/tracy/zstd/compress/*.h
+    cbits/tracy/zstd/decompress/*.S
     cbits/tracy/zstd/decompress/*.c
-    cbits/tracy/zstd/dictBuilder/*.h
+    cbits/tracy/zstd/decompress/*.h
     cbits/tracy/zstd/dictBuilder/*.c
+    cbits/tracy/zstd/dictBuilder/*.h
 
 extra-doc-files:
     images/*.png
diff --git a/cbits/tracy b/cbits/tracy
index 07778badc..5a1f5371b 160000
--- a/cbits/tracy
+++ b/cbits/tracy
@@ -1 +1 @@
-Subproject commit 07778badcced109b8190805fbf2d7abfaef0d3b9
+Subproject commit 5a1f5371b792c12aea324213e1dc738b2923ae21
diff --git a/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs b/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs
index 57afcd3e8..26966b70b 100644
--- a/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs
+++ b/src/Data/Array/Accelerate/Debug/Internal/Tracy.hs
@@ -31,8 +31,18 @@ type SrcLoc = Word64
 --
 #if defined(ACCELERATE_DEBUG) && !defined(__GHCIDE__)
 
-foreign import ccall unsafe "___tracy_init_thread" init_thread :: IO ()
-foreign import ccall unsafe "___tracy_set_thread_name" set_thread_name :: CString -> IO ()
+#ifdef TRACY_MANUAL_LIFETIME
+foreign import ccall unsafe "___tracy_startup_profiler" startup_profiler :: IO ()
+foreign import ccall unsafe "___tracy_shutdown_profiler" shutdown_profiler :: IO ()
+#else
+startup_profiler :: IO ()
+startup_profiler = return ()
+
+shutdown_profiler :: IO ()
+shutdown_profiler = return ()
+#endif
+
+foreign import ccall unsafe "___tracy_connected" tracy_connected :: IO CInt
 
 foreign import ccall unsafe "___tracy_alloc_srcloc" alloc_srcloc :: Word32 -> CString -> CSize -> CString -> CSize -> IO SrcLoc
 foreign import ccall unsafe "___tracy_alloc_srcloc_name" alloc_srcloc_name :: Word32 -> CString -> CSize -> CString -> CSize -> CString -> CSize -> IO SrcLoc
@@ -62,19 +72,33 @@ foreign import ccall unsafe "___tracy_emit_frame_image" emit_frame_image :: Ptr
 foreign import ccall unsafe "___tracy_emit_plot" emit_plot :: CString -> Double -> IO ()
 foreign import ccall unsafe "___tracy_emit_message_appinfo" emit_message_appinfo :: CString -> CSize -> IO ()
 
+#ifdef TRACY_FIBERS
+foreign import ccall unsafe "___tracy_fiber_enter" fiber_enter :: CString -> IO ()
+foreign import ccall unsafe "___tracy_fiber_leave" fiber_leave :: IO ()
+#else
+fiber_enter :: CString -> IO ()
+fiber_enter _ = return ()
+
+fiber_leave :: IO ()
+fiber_leave   = return ()
+#endif
+
 -- SEE: [linking to .c files]
 --
 runQ $ do
-  addForeignFilePath LangCxx "cbits/tracy/TracyClient.cpp"
+  addForeignFilePath LangCxx "cbits/tracy/public/TracyClient.cpp"
   return []
 
 #else
 
-init_thread :: IO ()
-init_thread = return ()
+startup_profiler :: IO ()
+startup_profiler = return ()
+
+shutdown_profiler :: IO ()
+shutdown_profiler = return ()
 
-set_thread_name :: CString -> IO ()
-set_thread_name _ = return ()
+tracy_connected :: IO CInt
+tracy_connected = return 0
 
 alloc_srcloc :: Word32 -> CString -> CSize -> CString -> CSize -> IO SrcLoc
 alloc_srcloc _ _ _ _ _ = return 0
@@ -142,5 +166,11 @@ emit_plot _ _ = return ()
 emit_message_appinfo :: CString -> CSize -> IO ()
 emit_message_appinfo _ _ = return ()
 
+fiber_enter :: CString -> IO ()
+fiber_enter _ = return ()
+
+fiber_leave :: IO ()
+fiber_leave = return ()
+
 #endif
 

From 1e8a9ca950a6b4684f4cae2ae0c3b270521e8413 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 11:46:20 +0100
Subject: [PATCH 06/62] build fix for ghc-9.4

---
 src/Data/Array/Accelerate/Debug/Internal/Timed.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/Data/Array/Accelerate/Debug/Internal/Timed.hs b/src/Data/Array/Accelerate/Debug/Internal/Timed.hs
index 05cf11e04..8e36194df 100644
--- a/src/Data/Array/Accelerate/Debug/Internal/Timed.hs
+++ b/src/Data/Array/Accelerate/Debug/Internal/Timed.hs
@@ -98,8 +98,8 @@ timed_gc fmt action = do
   rts1  <- liftIO getRTSStats
   --
   let
-      w64 (W64# w#) = D# (word2Double# w#)
-      i64 (I64# i#) = D# (int2Double# i#)
+      w64 (W64# w#) = D# (word2Double# (word64ToWord# w#))
+      i64 (I64# i#) = D# (int2Double# (int64ToInt# i#))
       --
       allocated   = w64 (allocated_bytes rts1 - allocated_bytes rts0)
       copied      = w64 (copied_bytes rts1 - copied_bytes rts0)
@@ -123,6 +123,14 @@ timed_gc fmt action = do
     gcWall gcCPU
 
   return res
+
+#if __GLASGOW_HASKELL__ < 904
+word64ToWord# :: Word# -> Word#
+word64ToWord# x = x
+
+int64ToInt# :: Int# -> Int#
+int64ToInt# x = x
+#endif
 #endif
 
 {-# INLINE elapsed #-}

From b8207f87aa006db224a4dbfa22b4ddc538d927bb Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 11:46:27 +0100
Subject: [PATCH 07/62] update stack.yaml

---
 stack-8.10.yaml | 2 +-
 stack-9.0.yaml  | 2 +-
 stack-9.2.yaml  | 3 +++
 stack-9.4.yaml  | 5 ++++-
 4 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/stack-8.10.yaml b/stack-8.10.yaml
index d0823dcbd..99c7ebd8e 100644
--- a/stack-8.10.yaml
+++ b/stack-8.10.yaml
@@ -2,7 +2,7 @@
 # For advanced use and comprehensive documentation of the format, please see:
 # https://docs.haskellstack.org/en/stable/yaml_configuration/
 
-resolver: lts-18.25
+resolver: lts-18.28
 
 packages:
 - .
diff --git a/stack-9.0.yaml b/stack-9.0.yaml
index 1349abd27..24c8a4ad7 100644
--- a/stack-9.0.yaml
+++ b/stack-9.0.yaml
@@ -2,7 +2,7 @@
 # For advanced use and comprehensive documentation of the format, please see:
 # https://docs.haskellstack.org/en/stable/yaml_configuration/
 
-resolver: nightly-2022-02-16
+resolver: lts-19.33
 
 packages:
 - .
diff --git a/stack-9.2.yaml b/stack-9.2.yaml
index d3a501d74..bf763c32d 100644
--- a/stack-9.2.yaml
+++ b/stack-9.2.yaml
@@ -11,6 +11,9 @@ packages:
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
+flags:
+  accelerate:
+    debug: true
 
 # Extra package databases containing global packages
 # extra-package-dbs: []
diff --git a/stack-9.4.yaml b/stack-9.4.yaml
index 55a0a2301..d54e553b2 100644
--- a/stack-9.4.yaml
+++ b/stack-9.4.yaml
@@ -2,7 +2,7 @@
 # For advanced use and comprehensive documentation of the format, please see:
 # https://docs.haskellstack.org/en/stable/yaml_configuration/
 
-resolver: nightly-2023-02-06
+resolver: nightly-2023-02-09
 
 packages:
 - .
@@ -11,6 +11,9 @@ packages:
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
+flags:
+  accelerate:
+    debug: true
 
 # Extra package databases containing global packages
 # extra-package-dbs: []

From db0c7fc2a1036f7bfb9f8e1645443b6008d765f8 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 12:19:00 +0100
Subject: [PATCH 08/62] update stack.yaml

---
 stack-9.2.yaml | 3 ---
 stack-9.4.yaml | 3 ---
 2 files changed, 6 deletions(-)

diff --git a/stack-9.2.yaml b/stack-9.2.yaml
index bf763c32d..d3a501d74 100644
--- a/stack-9.2.yaml
+++ b/stack-9.2.yaml
@@ -11,9 +11,6 @@ packages:
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
-flags:
-  accelerate:
-    debug: true
 
 # Extra package databases containing global packages
 # extra-package-dbs: []
diff --git a/stack-9.4.yaml b/stack-9.4.yaml
index d54e553b2..2be52db95 100644
--- a/stack-9.4.yaml
+++ b/stack-9.4.yaml
@@ -11,9 +11,6 @@ packages:
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
-flags:
-  accelerate:
-    debug: true
 
 # Extra package databases containing global packages
 # extra-package-dbs: []

From c957503d76f7b51576e846a2c7bddae84633eb83 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 12:20:45 +0100
Subject: [PATCH 09/62] fix ci.yml

---
 .github/workflows/ci-linux.yml | 4 ++--
 .github/workflows/ci-macos.yml | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index 3a3864f3e..3e37a37a2 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -48,13 +48,13 @@ jobs:
           sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
 
       - name: actions/cache-always@v3
-        uses: .github/actions/cache-always
+        uses: ./.github/actions/cache-always
         with:
           path: snapshot.pkgdb
           key: ${{ runner.os }}-${{ matrix.ghc }}-snapshot.pkgdb
 
       - name: actions/cache-always@v3
-        uses: .github/actions/cache-always
+        uses: ./.github/actions/cache-always
         with:
           path: |
             ~/.local/bin
diff --git a/.github/workflows/ci-macos.yml b/.github/workflows/ci-macos.yml
index dbf37a521..a32d7d5b5 100644
--- a/.github/workflows/ci-macos.yml
+++ b/.github/workflows/ci-macos.yml
@@ -48,13 +48,13 @@ jobs:
           sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
 
       - name: actions/cache-always@v3
-        uses: .github/actions/cache-always
+        uses: ./.github/actions/cache-always
         with:
           path: snapshot.pkgdb
           key: ${{ runner.os }}-${{ matrix.ghc }}-snapshot.pkgdb
 
       - name: actions/cache-always@v3
-        uses: .github/actions/cache-always
+        uses: ./.github/actions/cache-always
         with:
           path: |
             ~/.local/bin

From 134cde6e491c0d4646f545932f21eb25a16e1ba8 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 15:00:49 +0100
Subject: [PATCH 10/62] ci update

---
 .github/workflows/ci-linux.yml | 24 +++++++++++++++---------
 .github/workflows/ci-macos.yml | 20 +++++++++++++-------
 2 files changed, 28 insertions(+), 16 deletions(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index 3e37a37a2..c6c3139cc 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -27,7 +27,7 @@ jobs:
           - "8.8"
           - "8.6"
     env:
-      STACK_FLAGS: "--fast --flag accelerate:nofib"
+      STACK_FLAGS: "--flag accelerate:nofib"
       HADDOCK_FLAGS: "--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments=\"--no-print-missing-docs\""
 
     steps:
@@ -67,13 +67,19 @@ jobs:
             ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('stack.yaml') }}-
             ${{ runner.os }}-${{ matrix.ghc }}-
 
-      - name: Install stack
+      # - name: Install stack
+      #   run: |
+      #      if [[ ! -x ~/.local/bin/stack ]]; then
+      #        curl -sL https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+      #        chmod a+x ~/.local/bin/stack
+      #      fi
+
+      - name: Setup stack
         run: |
           mkdir -p ~/.local/bin
-          # if [[ ! -x ~/.local/bin/stack ]]; then
-          #   curl -sL https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
-          #   chmod a+x ~/.local/bin/stack
-          # fi
+          mkdir -p ~/.stack/hooks
+          curl https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/hooks/stack/ghc-install.sh > ~/.stack/hooks/ghc-install.sh
+          chmod +x ~/.stack/hooks/ghc-install.sh
           echo "~/.local/bin" >> $GITHUB_PATH
 
       - name: Install GHC
@@ -85,9 +91,9 @@ jobs:
       - name: Build
         run: stack build $STACK_FLAGS $HADDOCK_FLAGS --test --no-run-tests
 
-      - name: Test doctest
-        run: stack test accelerate:doctest $STACK_FLAGS
-        if: ${{ matrix.ghc != '9.2' }}
+      # - name: Test doctest
+      #   run: stack test accelerate:doctest $STACK_FLAGS
+      #   if: ${{ matrix.ghc != '9.2' }} && ${{ matrix.ghc != '9.4' }}
 
       - name: Test nofib
         run: stack test accelerate:nofib-interpreter $STACK_FLAGS
diff --git a/.github/workflows/ci-macos.yml b/.github/workflows/ci-macos.yml
index a32d7d5b5..f57a894ed 100644
--- a/.github/workflows/ci-macos.yml
+++ b/.github/workflows/ci-macos.yml
@@ -27,7 +27,7 @@ jobs:
           - "8.8"
           - "8.6"
     env:
-      STACK_FLAGS: "--fast --flag accelerate:nofib"
+      STACK_FLAGS: "--flag accelerate:nofib"
       HADDOCK_FLAGS: "--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments=\"--no-print-missing-docs\""
 
     steps:
@@ -67,14 +67,20 @@ jobs:
             ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('stack.yaml') }}-
             ${{ runner.os }}-${{ matrix.ghc }}-
 
-      - name: Install stack
+      # - name: Install stack
+      #   run: |
+      #     if [[ ! -x ~/.local/bin/stack ]]; then
+      #       brew install gnu-tar
+      #       curl -sL https://get.haskellstack.org/stable/osx-x86_64.tar.gz | gtar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
+      #       chmod a+x ~/.local/bin/stack
+      #     fi
+
+      - name: Setup stack
         run: |
           mkdir -p ~/.local/bin
-          # if [[ ! -x ~/.local/bin/stack ]]; then
-          #   brew install gnu-tar
-          #   curl -sL https://get.haskellstack.org/stable/osx-x86_64.tar.gz | gtar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
-          #   chmod a+x ~/.local/bin/stack
-          # fi
+          mkdir -p ~/.stack/hooks
+          curl https://raw.githubusercontent.com/haskell/ghcup-hs/master/scripts/hooks/stack/ghc-install.sh > ~/.stack/hooks/ghc-install.sh
+          chmod +x ~/.stack/hooks/ghc-install.sh
           echo "~/.local/bin" >> $GITHUB_PATH
 
       - name: Install GHC

From bfb780e11e374a19c99c81bb7d75fd7fd32f5e7b Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 15:18:20 +0100
Subject: [PATCH 11/62] update ci-windows

---
 .github/workflows/ci-windows.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/ci-windows.yml b/.github/workflows/ci-windows.yml
index b8fc20cb3..54ff5cb5e 100644
--- a/.github/workflows/ci-windows.yml
+++ b/.github/workflows/ci-windows.yml
@@ -68,6 +68,7 @@ jobs:
 
       - name: Test nofib
         run: stack --no-terminal test accelerate:nofib-interpreter --fast --flag accelerate:nofib
+        if: ${{ matrix.ghc != '8.10' }} && ${{ matrix.ghc != '9.0' }} && ${{ matrix.ghc != '9.2' }}
 
       # - name: Test haddock generation
       #   run: stack --no-terminal haddock --haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs" --fast --flag accelerate:nofib

From 103e9e049490524edb8d9d4554370a6be1986d83 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 9 Feb 2023 15:27:27 +0100
Subject: [PATCH 12/62] update ci-windows

---
 .github/workflows/ci-windows.yml | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/ci-windows.yml b/.github/workflows/ci-windows.yml
index 54ff5cb5e..02ab2a953 100644
--- a/.github/workflows/ci-windows.yml
+++ b/.github/workflows/ci-windows.yml
@@ -66,9 +66,8 @@ jobs:
       # - name: Test doctest
       #   run: stack --no-terminal test accelerate:doctest --fast --flag accelerate:nofib
 
-      - name: Test nofib
-        run: stack --no-terminal test accelerate:nofib-interpreter --fast --flag accelerate:nofib
-        if: ${{ matrix.ghc != '8.10' }} && ${{ matrix.ghc != '9.0' }} && ${{ matrix.ghc != '9.2' }}
+      # - name: Test nofib
+      #   run: stack --no-terminal test accelerate:nofib-interpreter --fast --flag accelerate:nofib
 
       # - name: Test haddock generation
       #   run: stack --no-terminal haddock --haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs" --fast --flag accelerate:nofib

From 886e6759f18a8828bca6f7f2d2382442a0f0d944 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sat, 18 Feb 2023 14:29:25 +0100
Subject: [PATCH 13/62] ci: debug and release builds?

---
 .github/workflows/ci-linux.yml | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index c6c3139cc..43e1f0bc8 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -26,8 +26,10 @@ jobs:
           - "8.10"
           - "8.8"
           - "8.6"
+        build:
+          - debug
+          - release
     env:
-      STACK_FLAGS: "--flag accelerate:nofib"
       HADDOCK_FLAGS: "--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments=\"--no-print-missing-docs\""
 
     steps:
@@ -74,6 +76,16 @@ jobs:
       #        chmod a+x ~/.local/bin/stack
       #      fi
 
+      - name: Setup environment
+        if: ${{ matrix.mode == 'release' }}
+        run: |
+          echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
+
+      - name: Setup environment
+        if: ${{ matrix.mode == 'debug' }}
+        run: |
+          echo 'STACK_FLAGS="--flag accelerate:nofib --flag accelerate:debug"' >> $GITHUB_ENV
+
       - name: Setup stack
         run: |
           mkdir -p ~/.local/bin

From 7a590215908dea77eac6013403a7d0f4feac0782 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sat, 18 Feb 2023 14:36:14 +0100
Subject: [PATCH 14/62] ci: syntax

---
 .github/workflows/ci-linux.yml | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index 43e1f0bc8..498f486eb 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -77,14 +77,12 @@ jobs:
       #      fi
 
       - name: Setup environment
-        if: ${{ matrix.mode == 'release' }}
         run: |
-          echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
-
-      - name: Setup environment
-        if: ${{ matrix.mode == 'debug' }}
-        run: |
-          echo 'STACK_FLAGS="--flag accelerate:nofib --flag accelerate:debug"' >> $GITHUB_ENV
+          if [ ${{ matrix.build }} == 'release' ]; then
+            echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
+          else
+            echo 'STACK_FLAGS="--flag accelerate:nofib --flag accelerate:debug"' >> $GITHUB_ENV
+          fi
 
       - name: Setup stack
         run: |

From 43ad133185407ab3c1b42d4449f261bfcfe16313 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sat, 18 Feb 2023 14:42:15 +0100
Subject: [PATCH 15/62] ci: syntax?

---
 .github/workflows/ci-linux.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index 498f486eb..3274cbff8 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -81,7 +81,7 @@ jobs:
           if [ ${{ matrix.build }} == 'release' ]; then
             echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
           else
-            echo 'STACK_FLAGS="--flag accelerate:nofib --flag accelerate:debug"' >> $GITHUB_ENV
+            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug' >> $GITHUB_ENV
           fi
 
       - name: Setup stack

From 3c9df77fc56b55b94a50c5b5d1295e3777738c85 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sat, 18 Feb 2023 14:47:02 +0100
Subject: [PATCH 16/62] ci: install tracy deps

---
 .github/workflows/ci-linux.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index 3274cbff8..d9c263c5b 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -81,6 +81,7 @@ jobs:
           if [ ${{ matrix.build }} == 'release' ]; then
             echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
           else
+            sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
             echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug' >> $GITHUB_ENV
           fi
 

From 5275b477e18f7e14df0b884c9eb9fd0e0b7e5f6c Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sun, 19 Feb 2023 15:21:30 +0100
Subject: [PATCH 17/62] =?UTF-8?q?ci:=20runner=20doesn=E2=80=99t=20support?=
 =?UTF-8?q?=20TSC?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .github/workflows/ci-linux.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index d9c263c5b..8744d308d 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -82,7 +82,7 @@ jobs:
             echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
           else
             sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
-            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug' >> $GITHUB_ENV
+            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options -optc=-DTRACY_TIMER_FALLBACK --ghc-options -optcxx=-DTRACY_TIMER_FALLBACK' >> $GITHUB_ENV
           fi
 
       - name: Setup stack

From 8ab91f8f3eab09af0d9ecd7c224e3ad4cc4d46a0 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sun, 19 Feb 2023 15:56:09 +0100
Subject: [PATCH 18/62] ci: haddock is awful

---
 .github/workflows/ci-linux.yml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index 8744d308d..ff421fe51 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -29,8 +29,6 @@ jobs:
         build:
           - debug
           - release
-    env:
-      HADDOCK_FLAGS: "--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments=\"--no-print-missing-docs\""
 
     steps:
       - uses: actions/checkout@v3
@@ -80,9 +78,11 @@ jobs:
         run: |
           if [ ${{ matrix.build }} == 'release' ]; then
             echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
+            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs"' >> $GITHUB_ENV
           else
             sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
-            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options -optc=-DTRACY_TIMER_FALLBACK --ghc-options -optcxx=-DTRACY_TIMER_FALLBACK' >> $GITHUB_ENV
+            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
+            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs --optghc=\"-optc=-DTRACY_TIMER_FALLBACK\" --optghc=\"-optcxx=-DTRACY_TIMER_FALLBACK\""' >> $GITHUB_ENV
           fi
 
       - name: Setup stack

From 16380265fced5476cdcae0d4ffc3fe413e75cfbc Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sun, 19 Feb 2023 16:06:20 +0100
Subject: [PATCH 19/62] ci: how does string quoting work?

---
 .github/workflows/ci-linux.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index ff421fe51..923ceab03 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -81,8 +81,8 @@ jobs:
             echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs"' >> $GITHUB_ENV
           else
             sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
-            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
-            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs --optghc=\"-optc=-DTRACY_TIMER_FALLBACK\" --optghc=\"-optcxx=-DTRACY_TIMER_FALLBACK\""' >> $GITHUB_ENV
+            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options=\'-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\'' >> $GITHUB_ENV
+            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs --optghc='-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK'"' >> $GITHUB_ENV
           fi
 
       - name: Setup stack

From e09e54ec9302650b5e35578fd07f3d328bdd4fd7 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sun, 19 Feb 2023 16:10:14 +0100
Subject: [PATCH 20/62] ci: more like sigh-eye

---
 .github/workflows/ci-linux.yml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index 923ceab03..dade6864b 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -78,11 +78,11 @@ jobs:
         run: |
           if [ ${{ matrix.build }} == 'release' ]; then
             echo 'STACK_FLAGS=--flag accelerate:nofib' >> $GITHUB_ENV
-            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs"' >> $GITHUB_ENV
+            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments --no-print-missing-docs' >> $GITHUB_ENV
           else
             sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
-            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options=\'-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\'' >> $GITHUB_ENV
-            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments="--no-print-missing-docs --optghc='-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK'"' >> $GITHUB_ENV
+            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
+            echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments --no-print-missing-docs --haddock-arguments --optghc="-optc=-DTRACY_TIMER_FALLBACK" --haddock-arguments --optghc="-optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
           fi
 
       - name: Setup stack

From cedade3ebae7582bd6766ad7436303e6fe902d83 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Sun, 19 Feb 2023 16:12:19 +0100
Subject: [PATCH 21/62] ci: one more time?

---
 .github/workflows/ci-linux.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci-linux.yml b/.github/workflows/ci-linux.yml
index dade6864b..b239886bd 100644
--- a/.github/workflows/ci-linux.yml
+++ b/.github/workflows/ci-linux.yml
@@ -81,7 +81,7 @@ jobs:
             echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments --no-print-missing-docs' >> $GITHUB_ENV
           else
             sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
-            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
+            echo 'STACK_FLAGS=--flag accelerate:nofib --flag accelerate:debug --ghc-options -optc=-DTRACY_TIMER_FALLBACK --ghc-options -optcxx=-DTRACY_TIMER_FALLBACK' >> $GITHUB_ENV
             echo 'HADDOCK_FLAGS=--haddock --no-haddock-deps --no-haddock-hyperlink-source --haddock-arguments --no-print-missing-docs --haddock-arguments --optghc="-optc=-DTRACY_TIMER_FALLBACK" --haddock-arguments --optghc="-optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
           fi
 

From 2dceda411e5c720f7f1de4524d326c37d0fffcb6 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:04:34 +0100
Subject: [PATCH 22/62] fix doctest

---
 src/Data/Array/Accelerate.hs          |  9 ---------
 src/Data/Array/Accelerate/Language.hs | 17 +++++++++--------
 2 files changed, 9 insertions(+), 17 deletions(-)

diff --git a/src/Data/Array/Accelerate.hs b/src/Data/Array/Accelerate.hs
index 2b869d74a..4f2b8d87b 100644
--- a/src/Data/Array/Accelerate.hs
+++ b/src/Data/Array/Accelerate.hs
@@ -470,15 +470,6 @@ import GHC.Generics                                                 ( Generic )
 import GHC.Stack
 
 
--- $setup
--- >>> :seti -XTypeOperators
--- >>> import Data.Array.Accelerate
--- >>> import Data.Array.Accelerate.Interpreter
--- >>> :{
---   let runExp :: Elt e => Exp e -> e
---       runExp e = indexArray (run (unit e)) Z
--- :}
-
 -- Renamings
 -- ---------
 --
diff --git a/src/Data/Array/Accelerate/Language.hs b/src/Data/Array/Accelerate/Language.hs
index 5d3ca5004..d32cd94a5 100644
--- a/src/Data/Array/Accelerate/Language.hs
+++ b/src/Data/Array/Accelerate/Language.hs
@@ -128,6 +128,7 @@ import Data.Type.Equality
 -- $setup
 -- >>> :seti -XFlexibleContexts
 -- >>> :seti -XScopedTypeVariables
+-- >>> :seti -XTypeApplications
 -- >>> :seti -XTypeOperators
 -- >>> :seti -XViewPatterns
 -- >>> import Data.Array.Accelerate
@@ -225,8 +226,8 @@ unit (Exp e) = Acc $ SmartAcc $ Unit (eltR @e) e
 -- type variable @sh@ takes.
 --
 -- >>> :{
---   let rep0 :: (Shape sh, Elt e) => Exp Int -> Acc (Array sh e) -> Acc (Array (sh :. Int) e)
---       rep0 n a = replicate (lift (Any :. n)) a
+--   let rep0 :: forall sh e. (Shape sh, Elt e) => Exp Int -> Acc (Array sh e) -> Acc (Array (sh :. Int) e)
+--       rep0 n a = replicate (lift (Any @sh :. n)) a
 -- :}
 --
 -- >>> let x = unit 42 :: Acc (Scalar Int)
@@ -249,8 +250,8 @@ unit (Exp e) = Acc $ SmartAcc $ Unit (eltR @e) e
 -- Of course, 'Any' and 'All' can be used together.
 --
 -- >>> :{
---   let rep1 :: (Shape sh, Elt e) => Exp Int -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int :. Int) e)
---       rep1 n a = replicate (lift (Any :. n :. All)) a
+--   let rep1 :: forall sh e. (Shape sh, Elt e) => Exp Int -> Acc (Array (sh :. Int) e) -> Acc (Array (sh :. Int :. Int) e)
+--       rep1 n a = replicate (lift (Any @sh :. n :. All)) a
 -- :}
 --
 -- >>> run $ rep1 5 (use vec)
@@ -363,8 +364,8 @@ reshape = Acc $$ applyAcc (Reshape $ shapeR @sh)
 --
 -- >>> :{
 --   let
---       sl0 :: (Shape sh, Elt e) => Acc (Array (sh:.Int) e) -> Exp Int -> Acc (Array sh e)
---       sl0 a n = slice a (lift (Any :. n))
+--       sl0 :: forall sh e. (Shape sh, Elt e) => Acc (Array (sh:.Int) e) -> Exp Int -> Acc (Array sh e)
+--       sl0 a n = slice a (lift (Any @sh :. n))
 -- :}
 --
 -- >>> let vec = fromList (Z:.10) [0..] :: Vector Int
@@ -377,8 +378,8 @@ reshape = Acc $$ applyAcc (Reshape $ shapeR @sh)
 -- Of course, 'Any' and 'All' can be used together.
 --
 -- >>> :{
---   let sl1 :: (Shape sh, Elt e) => Acc (Array (sh:.Int:.Int) e) -> Exp Int -> Acc (Array (sh:.Int) e)
---       sl1 a n = slice a (lift (Any :. n :. All))
+--   let sl1 :: forall sh e. (Shape sh, Elt e) => Acc (Array (sh:.Int:.Int) e) -> Exp Int -> Acc (Array (sh:.Int) e)
+--       sl1 a n = slice a (lift (Any @sh :. n :. All))
 -- :}
 --
 -- >>> run $ sl1 (use mat) 4

From cf9efe9cb1fb78b12b09f5316e7e9d74cc545463 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:09:44 +0100
Subject: [PATCH 23/62] =?UTF-8?q?fix:=20panic!=20(the=20=E2=80=98impossibl?=
 =?UTF-8?q?e=E2=80=99=20happened)=20piResultTys1?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .../Array/Accelerate/Classes/RealFrac.hs-boot | 21 ++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/src/Data/Array/Accelerate/Classes/RealFrac.hs-boot b/src/Data/Array/Accelerate/Classes/RealFrac.hs-boot
index 0c2fa7307..1bb85ec04 100644
--- a/src/Data/Array/Accelerate/Classes/RealFrac.hs-boot
+++ b/src/Data/Array/Accelerate/Classes/RealFrac.hs-boot
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 -- |
 -- Module      : Data.Array.Accelerate.Classes.RealFrac
@@ -12,9 +13,27 @@
 module Data.Array.Accelerate.Classes.RealFrac
   where
 
+import Data.Array.Accelerate.Smart
 import Data.Array.Accelerate.Type
 
-class RealFrac a
+import Data.Array.Accelerate.Classes.Fractional
+import Data.Array.Accelerate.Classes.FromIntegral
+import Data.Array.Accelerate.Classes.Integral
+import Data.Array.Accelerate.Classes.Ord
+
+import qualified Prelude                                            as P
+
+class (Ord a, Fractional a) => RealFrac a where
+  properFraction :: (Integral b, FromIntegral Int64 b) => Exp a -> (Exp b, Exp a)
+  truncate :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
+  round    :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
+  ceiling  :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
+  floor    :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
+
+  truncate = P.undefined
+  round    = P.undefined
+  ceiling  = P.undefined
+  floor    = P.undefined
 
 instance RealFrac Half
 instance RealFrac Float

From 9d8b8529e6f7d23b875d51c6b80336bf37abc341 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:11:09 +0100
Subject: [PATCH 24/62] =?UTF-8?q?ci:=20let=E2=80=99s=20try=20something=20c?=
 =?UTF-8?q?razy?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .github/workflows/ci.yml | 118 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 118 insertions(+)
 create mode 100644 .github/workflows/ci.yml

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
new file mode 100644
index 000000000..63a8c292a
--- /dev/null
+++ b/.github/workflows/ci.yml
@@ -0,0 +1,118 @@
+name: ci
+
+# Trigger the workflow on push or pull request
+on:
+  workflow_dispatch:
+  pull_request:
+    # branches: [master]
+    types: [synchronize, opened, reopened]
+  push:
+    # branches: [main]
+    paths:
+      - '.github/workflows/ci.yml'
+      - '*.cabal'
+      - 'cabal.project'
+      - 'src/**'
+      - 'test/**'
+      - 'cbits/**'
+  schedule:
+    # additionally run once per week (At 00:00 on Sunday) to maintain cache
+    - cron: '0 0 * * 0'
+
+jobs:
+  cabal:
+    name: ${{ matrix.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - 'ubuntu-latest'
+          - 'macOS-latest'
+          - 'windows-latest'
+        ghc:
+          - 'latest'
+          - '9.4'
+          - '9.2'
+          - '9.0'
+          - '8.10'
+          - '8.8'
+          - '8.6'
+        mode:
+          - 'debug'
+          - 'release'
+        exclude:
+          - os: 'windows-latest'
+            mode: 'debug'
+
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: actions/checkout@v3
+        with:
+          repository: actions/cache
+          path: .github/actions/cache-always
+          ref: v3
+
+      # Tweak `action.yml` of `actions/cache@v3` to remove the `post-if`
+      # condition, making it default to `post-if: always ()`.
+      - name: Set up actions/cache-always@v3
+        run: |
+          sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
+
+      - name: Set up Haskell
+        uses: haskell/actions/setup@v2
+        id: setup-haskell
+        with:
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: latest
+
+      - name: Set up environment
+        run: |
+          if [ ${{ matrix.mode }} == 'release' ]; then
+            echo 'CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib' >> $GITHUB_ENV
+          else
+            if [ ${{ matrix.os }} == 'ubuntu-latest' ]; then
+              sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
+            elif [ ${{ matrix.os }} == 'macOS-latest' ]; then
+              brew install pkg-config capstone freetype glfw
+            fi
+            echo 'CABAL_FLAGS=--enable-tests --test-show-details=direct --flags="nofib debug" --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
+          fi
+
+      - name: Configure
+        run: |
+          cabal configure $CABAL_FLAGS
+
+      - name: Freeze
+        run: |
+          cabal freeze
+
+      - name: actions/cache-always@v3
+        uses: ./.github/actions/cache-always
+        with:
+          path: |
+            ${{ steps.setup-haskell.outputs.cabal-store }}
+            dist-newstyle
+          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
+          restore-keys: |
+            ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
+            ${{ runner.os }}-${{ matrix.ghc }}-
+
+      - name: Build dependencies
+        run: cabal build --only-dependencies
+
+      - name: Build
+        run: cabal build
+
+      - name: Documentation
+        run: cabal haddock
+
+      - name: Test doctest
+        run: cabal test doctest
+        if: ${{ matrix.os == 'ubuntu-latest' }}
+
+      - name: Test nofib
+        run: stack test nofib-interpreter
+
+# vi: nospell

From 118c0f7f21c0ab15a3fced5dbebb8271bce8f044 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:32:48 +0100
Subject: [PATCH 25/62] ci: nog een keer

---
 .github/workflows/ci.yml | 38 +++++++++++++++++++++++---------------
 1 file changed, 23 insertions(+), 15 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 63a8c292a..a36a449d3 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -20,8 +20,8 @@ on:
     - cron: '0 0 * * 0'
 
 jobs:
-  cabal:
-    name: ${{ matrix.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
+  build:
+    name: ${{ runner.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
@@ -31,13 +31,13 @@ jobs:
           - 'macOS-latest'
           - 'windows-latest'
         ghc:
-          - 'latest'
+          # - 'latest'
           - '9.4'
-          - '9.2'
-          - '9.0'
-          - '8.10'
-          - '8.8'
-          - '8.6'
+          # - '9.2'
+          # - '9.0'
+          # - '8.10'
+          # - '8.8'
+          # - '8.6'
         mode:
           - 'debug'
           - 'release'
@@ -70,23 +70,31 @@ jobs:
       - name: Set up environment
         run: |
           if [ ${{ matrix.mode }} == 'release' ]; then
-            echo 'CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib' >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib >> $GITHUB_ENV
           else
             if [ ${{ matrix.os }} == 'ubuntu-latest' ]; then
               sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
             elif [ ${{ matrix.os }} == 'macOS-latest' ]; then
               brew install pkg-config capstone freetype glfw
             fi
-            echo 'CABAL_FLAGS=--enable-tests --test-show-details=direct --flags="nofib debug" --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK"' >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags="nofib debug" --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK" >> $GITHUB_ENV
           fi
+        if: ${{ matrix.os != 'windows-latest' }}
+
+      - name: Set up environment
+        run: echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib >> $env:GITHUB_ENV
+        if: ${{ matrix.os == 'windows-latest' }}
 
       - name: Configure
-        run: |
-          cabal configure $CABAL_FLAGS
+        run: cabal configure $CABAL_FLAGS
+        if: ${{ matrix.os != 'windows-latest' }}
+
+      - name: Configure
+        run: cabal configure $env:CABAL_FLAGS
+        if: ${{ matrix.os == 'windows-latest' }}
 
       - name: Freeze
-        run: |
-          cabal freeze
+        run: cabal freeze
 
       - name: actions/cache-always@v3
         uses: ./.github/actions/cache-always
@@ -105,7 +113,7 @@ jobs:
       - name: Build
         run: cabal build
 
-      - name: Documentation
+      - name: Haddock
         run: cabal haddock
 
       - name: Test doctest

From ee24c1461c807611ce517c3a2d3e9b16842cdecc Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:35:34 +0100
Subject: [PATCH 26/62] ci: syntax

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index a36a449d3..44818a21e 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -21,7 +21,7 @@ on:
 
 jobs:
   build:
-    name: ${{ runner.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
+    name: runner.os ghc-${{ matrix.ghc }} ${{ matrix.mode }}
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false

From bcab408ff07a7c4b19a14c356c682cbe2059e4c5 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:38:06 +0100
Subject: [PATCH 27/62] ci: string quoting (again)

---
 .github/workflows/ci.yml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 44818a21e..ebe8a4800 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -21,7 +21,6 @@ on:
 
 jobs:
   build:
-    name: runner.os ghc-${{ matrix.ghc }} ${{ matrix.mode }}
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
@@ -77,7 +76,7 @@ jobs:
             elif [ ${{ matrix.os }} == 'macOS-latest' ]; then
               brew install pkg-config capstone freetype glfw
             fi
-            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags="nofib debug" --ghc-options="-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK" >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=\"nofib debug\" --ghc-options=\"-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\" >> $GITHUB_ENV
           fi
         if: ${{ matrix.os != 'windows-latest' }}
 

From 76716fa64f327c114eaefd2631c5848e7490e327 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:43:57 +0100
Subject: [PATCH 28/62] ci: boop

---
 .github/workflows/ci.yml | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index ebe8a4800..c1def39be 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -21,6 +21,7 @@ on:
 
 jobs:
   build:
+    name: ${{ matrix.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
@@ -69,14 +70,14 @@ jobs:
       - name: Set up environment
         run: |
           if [ ${{ matrix.mode }} == 'release' ]; then
-            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=\"+nofib\" >> $GITHUB_ENV
           else
             if [ ${{ matrix.os }} == 'ubuntu-latest' ]; then
               sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
             elif [ ${{ matrix.os }} == 'macOS-latest' ]; then
               brew install pkg-config capstone freetype glfw
             fi
-            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=\"nofib debug\" --ghc-options=\"-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\" >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=\"+nofib +debug\" --ghc-options=\"-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\" >> $GITHUB_ENV
           fi
         if: ${{ matrix.os != 'windows-latest' }}
 
@@ -101,10 +102,10 @@ jobs:
           path: |
             ${{ steps.setup-haskell.outputs.cabal-store }}
             dist-newstyle
-          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
+          key: ${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
           restore-keys: |
-            ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
-            ${{ runner.os }}-${{ matrix.ghc }}-
+            ${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
+            ${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-
 
       - name: Build dependencies
         run: cabal build --only-dependencies

From a69a5388354bfea14ba90ff3d9f294a0495d3f73 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:55:01 +0100
Subject: [PATCH 29/62] ci: idk man

---
 .github/workflows/ci.yml | 16 ++++------------
 1 file changed, 4 insertions(+), 12 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index c1def39be..bf3bcc0e1 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -70,28 +70,20 @@ jobs:
       - name: Set up environment
         run: |
           if [ ${{ matrix.mode }} == 'release' ]; then
-            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=\"+nofib\" >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib >> $GITHUB_ENV
           else
             if [ ${{ matrix.os }} == 'ubuntu-latest' ]; then
               sudo apt-get -y install pkg-config libcapstone-dev libfreetype-dev libglfw3-dev libgtk-3-dev libtbb-dev
             elif [ ${{ matrix.os }} == 'macOS-latest' ]; then
               brew install pkg-config capstone freetype glfw
             fi
-            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=\"+nofib +debug\" --ghc-options=\"-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\" >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib --flags=debug --ghc-options=\"-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\" >> $GITHUB_ENV
           fi
-        if: ${{ matrix.os != 'windows-latest' }}
-
-      - name: Set up environment
-        run: echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib >> $env:GITHUB_ENV
-        if: ${{ matrix.os == 'windows-latest' }}
+        shell: bash
 
       - name: Configure
         run: cabal configure $CABAL_FLAGS
-        if: ${{ matrix.os != 'windows-latest' }}
-
-      - name: Configure
-        run: cabal configure $env:CABAL_FLAGS
-        if: ${{ matrix.os == 'windows-latest' }}
+        shell: bash
 
       - name: Freeze
         run: cabal freeze

From 7810c0f9e663628db87ea011aa55890756006f9f Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 13:57:35 +0100
Subject: [PATCH 30/62] ci: moar

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index bf3bcc0e1..c822fd977 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -77,7 +77,7 @@ jobs:
             elif [ ${{ matrix.os }} == 'macOS-latest' ]; then
               brew install pkg-config capstone freetype glfw
             fi
-            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib --flags=debug --ghc-options=\"-optc=-DTRACY_TIMER_FALLBACK -optcxx=-DTRACY_TIMER_FALLBACK\" >> $GITHUB_ENV
+            echo CABAL_FLAGS=--enable-tests --test-show-details=direct --flags=nofib --flags=debug --ghc-options=\"-optc=-DTRACY_TIMER_FALLBACK\" --ghc-options=\"-optcxx=-DTRACY_TIMER_FALLBACK\" >> $GITHUB_ENV
           fi
         shell: bash
 

From 4c63f69d83f36d82fcc9c716cbf54cc33c176e4a Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 14:01:18 +0100
Subject: [PATCH 31/62] ci: derp

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index c822fd977..053e3cedb 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -113,6 +113,6 @@ jobs:
         if: ${{ matrix.os == 'ubuntu-latest' }}
 
       - name: Test nofib
-        run: stack test nofib-interpreter
+        run: cabal test nofib-interpreter
 
 # vi: nospell

From b2575b0fb29b6d3d7b67519c2afcf07a7db44648 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 14:34:55 +0100
Subject: [PATCH 32/62] =?UTF-8?q?ci:=20don=E2=80=99t=20test=20on=20windows?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .github/workflows/ci.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 053e3cedb..1cc435bc6 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -114,5 +114,6 @@ jobs:
 
       - name: Test nofib
         run: cabal test nofib-interpreter
+        if: ${{ matrix.os != 'windows-latest' }}
 
 # vi: nospell

From 823b428c2311cc9ec58b1b08b5373268eeb514f0 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 14:35:04 +0100
Subject: [PATCH 33/62] ci: only haddock in release

---
 .github/workflows/ci.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 1cc435bc6..d84851cdc 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -107,6 +107,7 @@ jobs:
 
       - name: Haddock
         run: cabal haddock
+        if: ${{ matrix.mode != 'debug' }}
 
       - name: Test doctest
         run: cabal test doctest

From 79600d0d71382630fc1064f032905a31bc348fdd Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 14:35:14 +0100
Subject: [PATCH 34/62] ci: enable ghc matrix

---
 .github/workflows/ci.yml | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index d84851cdc..d7edaa37f 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -31,13 +31,13 @@ jobs:
           - 'macOS-latest'
           - 'windows-latest'
         ghc:
-          # - 'latest'
+          - 'latest'
           - '9.4'
-          # - '9.2'
-          # - '9.0'
-          # - '8.10'
-          # - '8.8'
-          # - '8.6'
+          - '9.2'
+          - '9.0'
+          - '8.10'
+          - '8.8'
+          - '8.6'
         mode:
           - 'debug'
           - 'release'

From eb6ab4fd7f1d748cab3d0ffba62dec7a5e8c580d Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 15:02:45 +0100
Subject: [PATCH 35/62] ci: drop old ghc

---
 .github/workflows/ci.yml | 2 --
 1 file changed, 2 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index d7edaa37f..e36121893 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -36,8 +36,6 @@ jobs:
           - '9.2'
           - '9.0'
           - '8.10'
-          - '8.8'
-          - '8.6'
         mode:
           - 'debug'
           - 'release'

From ed5f21660d6920e0130caaeb59e6668b10a30c5c Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 15:02:58 +0100
Subject: [PATCH 36/62] =?UTF-8?q?ci:=20doctest=20also=20doesn=E2=80=99t=20?=
 =?UTF-8?q?like=20debug=20mode?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index e36121893..87ced5320 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -109,7 +109,7 @@ jobs:
 
       - name: Test doctest
         run: cabal test doctest
-        if: ${{ matrix.os == 'ubuntu-latest' }}
+        if: ${{ matrix.os == 'ubuntu-latest' }} && ${{ matrix.mode != 'debug' }}
 
       - name: Test nofib
         run: cabal test nofib-interpreter

From f7f9a25f5b0a8d58f98de817f1842f468d10d192 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 15:03:49 +0100
Subject: [PATCH 37/62] ci: disable workflow_dispatch trigger

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 87ced5320..1c8fa20cd 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -2,7 +2,7 @@ name: ci
 
 # Trigger the workflow on push or pull request
 on:
-  workflow_dispatch:
+  # workflow_dispatch:
   pull_request:
     # branches: [master]
     types: [synchronize, opened, reopened]

From 08af028c59da9d02b67c3fd503ae6626accd515c Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 16:46:34 +0100
Subject: [PATCH 38/62] doctest fix

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

diff --git a/src/Data/Array/Accelerate.hs b/src/Data/Array/Accelerate.hs
index 4f2b8d87b..929f2fe21 100644
--- a/src/Data/Array/Accelerate.hs
+++ b/src/Data/Array/Accelerate.hs
@@ -469,6 +469,10 @@ import GHC.Exts                                                     ( fromListN,
 import GHC.Generics                                                 ( Generic )
 import GHC.Stack
 
+-- $setup
+-- >>> :seti -XTypeOperators
+-- >>> import Data.Array.Accelerate
+
 
 -- Renamings
 -- ---------

From 881091187bdde8f5e96ddf7490d17a6b22a4274c Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 17:21:30 +0100
Subject: [PATCH 39/62] ci: conditionals?

---
 .github/workflows/ci.yml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 1c8fa20cd..abc7894f6 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -105,14 +105,14 @@ jobs:
 
       - name: Haddock
         run: cabal haddock
-        if: ${{ matrix.mode != 'debug' }}
+        if: ${{ matrix.mode }} == 'release'
 
       - name: Test doctest
         run: cabal test doctest
-        if: ${{ matrix.os == 'ubuntu-latest' }} && ${{ matrix.mode != 'debug' }}
+        if: ${{ matrix.os }} == 'ubuntu-latest' && ${{ matrix.mode }} == 'release'
 
       - name: Test nofib
         run: cabal test nofib-interpreter
-        if: ${{ matrix.os != 'windows-latest' }}
+        if: ${{ matrix.os }} != 'windows-latest'
 
 # vi: nospell

From 14deab86c37266db5efbabcc24562e227617b229 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 22 Feb 2023 17:39:52 +0100
Subject: [PATCH 40/62] ci: ._.

---
 .github/workflows/ci.yml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index abc7894f6..452667eae 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -105,14 +105,14 @@ jobs:
 
       - name: Haddock
         run: cabal haddock
-        if: ${{ matrix.mode }} == 'release'
+        if: matrix.mode == 'release'
 
       - name: Test doctest
         run: cabal test doctest
-        if: ${{ matrix.os }} == 'ubuntu-latest' && ${{ matrix.mode }} == 'release'
+        if: matrix.os == 'ubuntu-latest' && matrix.mode == 'release'
 
       - name: Test nofib
         run: cabal test nofib-interpreter
-        if: ${{ matrix.os }} != 'windows-latest'
+        if: matrix.os != 'windows-latest'
 
 # vi: nospell

From c81a0c9819461ffb71a3a7914124bef09341fab8 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 23 Feb 2023 13:34:51 +0100
Subject: [PATCH 41/62] ci: aarch64?

---
 .github/workflows/ci.yml | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 452667eae..79b198454 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -21,8 +21,8 @@ on:
 
 jobs:
   build:
-    name: ${{ matrix.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
-    runs-on: ${{ matrix.os }}
+    name: ${{ matrix.os }}-${{ matrix.arch }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
+    runs-on: [ ${{ matrix.os }}, ${{ matrix.arch }} ]
     strategy:
       fail-fast: false
       matrix:
@@ -30,6 +30,9 @@ jobs:
           - 'ubuntu-latest'
           - 'macOS-latest'
           - 'windows-latest'
+        arch:
+          - "x64"
+          - "ARM64"
         ghc:
           - 'latest'
           - '9.4'
@@ -42,6 +45,10 @@ jobs:
         exclude:
           - os: 'windows-latest'
             mode: 'debug'
+          - os: 'windows-latest'
+            arch: "ARM64"
+          - os: 'ubuntu-latest'
+            arch: "ARM64"
 
     steps:
       - uses: actions/checkout@v3
@@ -92,10 +99,10 @@ jobs:
           path: |
             ${{ steps.setup-haskell.outputs.cabal-store }}
             dist-newstyle
-          key: ${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
+          key: ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
           restore-keys: |
-            ${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
-            ${{ matrix.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-
+            ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
+            ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-
 
       - name: Build dependencies
         run: cabal build --only-dependencies

From fd5089f98e22527ad0bfc93cd789a49be58f503e Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 23 Feb 2023 13:45:41 +0100
Subject: [PATCH 42/62] ci: wot?

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 79b198454..923876ce5 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -22,7 +22,7 @@ on:
 jobs:
   build:
     name: ${{ matrix.os }}-${{ matrix.arch }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
-    runs-on: [ ${{ matrix.os }}, ${{ matrix.arch }} ]
+    runs-on: ${{ matrix.os }} ${{ matrix.arch }}
     strategy:
       fail-fast: false
       matrix:

From acf2a629e8f3464e982ad1bcf9b18a6887768eed Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 23 Feb 2023 13:53:44 +0100
Subject: [PATCH 43/62] ci: nope

---
 .github/workflows/ci.yml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 923876ce5..fc14f1621 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -21,8 +21,8 @@ on:
 
 jobs:
   build:
-    name: ${{ matrix.os }}-${{ matrix.arch }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
-    runs-on: ${{ matrix.os }} ${{ matrix.arch }}
+    name: ${{ matrix.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
+    runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
       matrix:
@@ -99,10 +99,10 @@ jobs:
           path: |
             ${{ steps.setup-haskell.outputs.cabal-store }}
             dist-newstyle
-          key: ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
+          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
           restore-keys: |
-            ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
-            ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-
+            ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
+            ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-
 
       - name: Build dependencies
         run: cabal build --only-dependencies

From b4adbb03be148afa5ab44737a1c6cb74e20ab8d1 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 23 Feb 2023 16:19:05 +0100
Subject: [PATCH 44/62] stackless

---
 README.md                                     | 17 ++++----
 .../accelerate.hsfiles                        |  0
 {.github/workflows => icebox}/ci-linux.yml    |  0
 {.github/workflows => icebox}/ci-macos.yml    |  0
 {.github/workflows => icebox}/ci-windows.yml  |  0
 stack-8.10.yaml                               | 36 -----------------
 stack-8.6.yaml                                | 39 -------------------
 stack-8.8.yaml                                | 36 -----------------
 stack-9.0.yaml                                | 36 -----------------
 stack-9.2.yaml                                | 36 -----------------
 stack-9.4.yaml                                | 36 -----------------
 11 files changed, 8 insertions(+), 228 deletions(-)
 rename accelerate.hsfiles => icebox/accelerate.hsfiles (100%)
 rename {.github/workflows => icebox}/ci-linux.yml (100%)
 rename {.github/workflows => icebox}/ci-macos.yml (100%)
 rename {.github/workflows => icebox}/ci-windows.yml (100%)
 delete mode 100644 stack-8.10.yaml
 delete mode 100644 stack-8.6.yaml
 delete mode 100644 stack-8.8.yaml
 delete mode 100644 stack-9.0.yaml
 delete mode 100644 stack-9.2.yaml
 delete mode 100644 stack-9.4.yaml

diff --git a/README.md b/README.md
index a0af7b863..af7201471 100644
--- a/README.md
+++ b/README.md
@@ -3,13 +3,10 @@
 
 # High-performance parallel arrays for Haskell
 
-[![CI-Linux](https://github.com/tmcdonell/accelerate/workflows/ci-linux/badge.svg)](https://github.com/tmcdonell/accelerate/actions?query=workflow%3Aci-linux)
-[![CI-MacOS](https://github.com/tmcdonell/accelerate/workflows/ci-macos/badge.svg)](https://github.com/tmcdonell/accelerate/actions?query=workflow%3Aci-macos)
-[![CI-Windows](https://github.com/tmcdonell/accelerate/workflows/ci-windows/badge.svg)](https://github.com/tmcdonell/accelerate/actions?query=workflow%3Aci-windows)
+[![CI](https://github.com/tmcdonell/accelerate/actions/workflows/ci.yml/badge.svg)](https://github.com/tmcdonell/accelerate/actions/workflows/ci.yml)
 [![Gitter](https://img.shields.io/gitter/room/nwjs/nw.js.svg)](https://gitter.im/AccelerateHS/Lobby)
-<br>
-[![Stackage LTS](https://stackage.org/package/accelerate/badge/lts)](https://stackage.org/lts/package/accelerate)
-[![Stackage Nightly](https://stackage.org/package/accelerate/badge/nightly)](https://stackage.org/nightly/package/accelerate)
+<!-- [![Stackage LTS](https://stackage.org/package/accelerate/badge/lts)](https://stackage.org/lts/package/accelerate) -->
+<!-- [![Stackage Nightly](https://stackage.org/package/accelerate/badge/nightly)](https://stackage.org/nightly/package/accelerate) -->
 [![Hackage](https://img.shields.io/hackage/v/accelerate.svg)](https://hackage.haskell.org/package/accelerate)
 
 </div>
@@ -61,10 +58,12 @@ Except for the type, this code is almost the same as the corresponding Haskell c
 Availability
 ------------
 
-Package accelerate is available from
+Package _Accelerate_ is available from:
 
  * Hackage: [accelerate][Hackage] - install with `cabal install accelerate`
- * GitHub: [AccelerateHS/accelerate][GitHub] - get the source with `git clone https://github.com/AccelerateHS/accelerate.git`. The easiest way to compile the source distributions is via the Haskell [stack](https://docs.haskellstack.org/en/stable/README/) tool.
+ * GitHub: [AccelerateHS/accelerate][GitHub] - get the source with `git clone https://github.com/AccelerateHS/accelerate.git` 
+
+To install the Haskell toolchain try [GHCup](https://www.haskell.org/ghcup/).
 
 Additional components
 ---------------------
@@ -105,7 +104,7 @@ Documentation
 -------------
 
   * Haddock documentation is included and linked with the individual package releases on [Hackage][Hackage].
-  * Haddock documentation for in-development components can be found [here](http://tmcdonell-bot.github.io/accelerate-travis-buildbot/).
+  <!-- * Haddock documentation for in-development components can be found [here](http://tmcdonell-bot.github.io/accelerate-travis-buildbot/). -->
   * The idea behind the HOAS (higher-order abstract syntax) to de-Bruijn conversion used in the library is [described separately][HOAS-conv].
 
 Examples
diff --git a/accelerate.hsfiles b/icebox/accelerate.hsfiles
similarity index 100%
rename from accelerate.hsfiles
rename to icebox/accelerate.hsfiles
diff --git a/.github/workflows/ci-linux.yml b/icebox/ci-linux.yml
similarity index 100%
rename from .github/workflows/ci-linux.yml
rename to icebox/ci-linux.yml
diff --git a/.github/workflows/ci-macos.yml b/icebox/ci-macos.yml
similarity index 100%
rename from .github/workflows/ci-macos.yml
rename to icebox/ci-macos.yml
diff --git a/.github/workflows/ci-windows.yml b/icebox/ci-windows.yml
similarity index 100%
rename from .github/workflows/ci-windows.yml
rename to icebox/ci-windows.yml
diff --git a/stack-8.10.yaml b/stack-8.10.yaml
deleted file mode 100644
index 99c7ebd8e..000000000
--- a/stack-8.10.yaml
+++ /dev/null
@@ -1,36 +0,0 @@
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-resolver: lts-18.28
-
-packages:
-- .
-
-# extra-deps:
-
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=1.9"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
-#
-# vim: nospell
diff --git a/stack-8.6.yaml b/stack-8.6.yaml
deleted file mode 100644
index 5d3724662..000000000
--- a/stack-8.6.yaml
+++ /dev/null
@@ -1,39 +0,0 @@
-# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
-# vim: nospell
-
-resolver: lts-14.27
-
-packages:
-- .
-
-extra-deps:
-- formatting-7.1.3
-- prettyprinter-1.7.1
-- prettyprinter-ansi-terminal-1.1.3
-- tasty-rerun-1.1.18
-- text-1.2.4.1
-
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra global and per-package GHC options
-# ghc-options: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: >= 0.1.4.0
-
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-
diff --git a/stack-8.8.yaml b/stack-8.8.yaml
deleted file mode 100644
index f9565e8b4..000000000
--- a/stack-8.8.yaml
+++ /dev/null
@@ -1,36 +0,0 @@
-# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
-# vim: nospell
-
-resolver: lts-16.31
-
-packages:
-- .
-
-extra-deps:
-- formatting-7.1.3
-- prettyprinter-1.7.1
-
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra global and per-package GHC options
-# ghc-options: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: >= 0.1.4.0
-
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-
diff --git a/stack-9.0.yaml b/stack-9.0.yaml
deleted file mode 100644
index 24c8a4ad7..000000000
--- a/stack-9.0.yaml
+++ /dev/null
@@ -1,36 +0,0 @@
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-resolver: lts-19.33
-
-packages:
-- .
-
-# extra-deps: []
-
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=1.9"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
-#
-# vim: nospell
diff --git a/stack-9.2.yaml b/stack-9.2.yaml
deleted file mode 100644
index d3a501d74..000000000
--- a/stack-9.2.yaml
+++ /dev/null
@@ -1,36 +0,0 @@
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-resolver: lts-20.10
-
-packages:
-- .
-
-# extra-deps: []
-
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=1.9"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
-#
-# vim: nospell
diff --git a/stack-9.4.yaml b/stack-9.4.yaml
deleted file mode 100644
index 2be52db95..000000000
--- a/stack-9.4.yaml
+++ /dev/null
@@ -1,36 +0,0 @@
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-resolver: nightly-2023-02-09
-
-packages:
-- .
-
-# extra-deps: []
-
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=1.9"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor
-#
-# vim: nospell

From 7f3afcc768213e233342891af65c2b3e23de3245 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Thu, 23 Feb 2023 16:26:09 +0100
Subject: [PATCH 45/62] update README.md

---
 README.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/README.md b/README.md
index af7201471..961832c2c 100644
--- a/README.md
+++ b/README.md
@@ -5,9 +5,9 @@
 
 [![CI](https://github.com/tmcdonell/accelerate/actions/workflows/ci.yml/badge.svg)](https://github.com/tmcdonell/accelerate/actions/workflows/ci.yml)
 [![Gitter](https://img.shields.io/gitter/room/nwjs/nw.js.svg)](https://gitter.im/AccelerateHS/Lobby)
-<!-- [![Stackage LTS](https://stackage.org/package/accelerate/badge/lts)](https://stackage.org/lts/package/accelerate) -->
-<!-- [![Stackage Nightly](https://stackage.org/package/accelerate/badge/nightly)](https://stackage.org/nightly/package/accelerate) -->
 [![Hackage](https://img.shields.io/hackage/v/accelerate.svg)](https://hackage.haskell.org/package/accelerate)
+[![Stackage LTS](https://stackage.org/package/accelerate/badge/lts)](https://stackage.org/lts/package/accelerate)
+[![Stackage Nightly](https://stackage.org/package/accelerate/badge/nightly)](https://stackage.org/nightly/package/accelerate)
 
 </div>
 

From 4b0f5cb575f926d9db0b9bc37a6177dd70336436 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 1 Mar 2023 12:14:17 +0100
Subject: [PATCH 46/62] ci: stack and wibbles

---
 .github/workflows/ci.yml | 76 ++++++++++++++++++++++++++++++++++------
 .gitignore               |  1 -
 stack.yaml               | 37 +++++++++++++++++++
 3 files changed, 103 insertions(+), 11 deletions(-)
 create mode 100644 stack.yaml

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index fc14f1621..b01e6425a 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -1,4 +1,4 @@
-name: ci
+name: CI
 
 # Trigger the workflow on push or pull request
 on:
@@ -20,8 +20,8 @@ on:
     - cron: '0 0 * * 0'
 
 jobs:
-  build:
-    name: ${{ matrix.os }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
+  cabal:
+    name: cabal | ${{ matrix.os }}-${{ matrix.arch }} ghc-${{ matrix.ghc }} ${{ matrix.mode }}
     runs-on: ${{ matrix.os }}
     strategy:
       fail-fast: false
@@ -45,10 +45,7 @@ jobs:
         exclude:
           - os: 'windows-latest'
             mode: 'debug'
-          - os: 'windows-latest'
-            arch: "ARM64"
-          - os: 'ubuntu-latest'
-            arch: "ARM64"
+          - arch: "ARM64"
 
     steps:
       - uses: actions/checkout@v3
@@ -99,10 +96,10 @@ jobs:
           path: |
             ${{ steps.setup-haskell.outputs.cabal-store }}
             dist-newstyle
-          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
+          key: ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-cabal-${{ hashFiles('cabal.project.freeze') }}
           restore-keys: |
-            ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-${{ hashFiles('cabal.project.freeze') }}
-            ${{ runner.os }}-${{ matrix.ghc }}-${{ matrix.mode }}-
+            ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-cabal-${{ hashFiles('cabal.project.freeze') }}
+            ${{ runner.os }}-${{ matrix.arch }}-${{ matrix.ghc }}-${{ matrix.mode }}-cabal-
 
       - name: Build dependencies
         run: cabal build --only-dependencies
@@ -122,4 +119,63 @@ jobs:
         run: cabal test nofib-interpreter
         if: matrix.os != 'windows-latest'
 
+  stack:
+    name: stack | ${{ matrix.os }}-${{ matrix.arch }}
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - 'ubuntu-latest'
+          - 'macOS-latest'
+          - 'windows-latest'
+        arch:
+          - "x64"
+          - "ARM64"
+        exclude:
+          - arch: "ARM64"
+
+    steps:
+      - uses: actions/checkout@v3
+
+      - uses: actions/checkout@v3
+        with:
+          repository: actions/cache
+          path: .github/actions/cache-always
+          ref: v3
+
+      # Tweak `action.yml` of `actions/cache@v3` to remove the `post-if`
+      # condition, making it default to `post-if: always ()`.
+      - name: Set up actions/cache-always@v3
+        run: |
+          sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
+
+      - name: Set up Haskell
+        uses: haskell/actions/setup@v2
+        id: setup-haskell
+        with:
+          enable-stack: true
+          stack-no-global: true
+          stack-setup:ghc: true
+
+      - name: actions/cache-always@v3
+        uses: ./.github/actions/cache-always
+        with:
+          path: |
+            ${{ steps.setup-haskell.outputs.stack-root }}
+            .stack-work
+          key: ${{ runner.os }}-${{ matrix.arch }}-stack-${{ hashFiles('stack.yaml') }}
+          restore-keys: |
+            ${{ runner.os }}-${{ matrix.arch }}-stack-${{ hashFiles('stack.yaml') }}
+            ${{ runner.os }}-${{ matrix.arch }}-stack-
+
+      - name: Setup
+        run: stack setup
+
+      - name: Build dependencies
+        run: stack build --only-dependencies
+
+      - name: Build
+        run: stack build
+
 # vi: nospell
diff --git a/.gitignore b/.gitignore
index 1467ca972..922dbbc64 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,7 +10,6 @@
 /accelerate-io/dist/
 /.stack-work
 /cabal.project.local*
-/stack.yaml
 /stack.yaml.lock
 .DS_Store
 *.lock
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 000000000..3d78a397b
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,37 @@
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+resolver: lts-20.12
+
+packages:
+- .
+
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.9"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor
+#
+# vim: nospell
+

From cc4eeee1ff54750090ff5adce97cb9cf9b93efc8 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 1 Mar 2023 23:09:11 +0100
Subject: [PATCH 47/62] ci: typo

---
 .github/workflows/ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index b01e6425a..e72bbd986 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -156,7 +156,7 @@ jobs:
         with:
           enable-stack: true
           stack-no-global: true
-          stack-setup:ghc: true
+          stack-setup-ghc: true
 
       - name: actions/cache-always@v3
         uses: ./.github/actions/cache-always

From 7e179676f39e72714cdd1b20f628e41f08310ecd Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 1 Mar 2023 23:16:02 +0100
Subject: [PATCH 48/62] =?UTF-8?q?ci/stack:=20don=E2=80=99t=20run=20setup?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .github/workflows/ci.yml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index e72bbd986..f9149dece 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -156,7 +156,6 @@ jobs:
         with:
           enable-stack: true
           stack-no-global: true
-          stack-setup-ghc: true
 
       - name: actions/cache-always@v3
         uses: ./.github/actions/cache-always

From 754048794011deb0e69b538fdcf5d82793918235 Mon Sep 17 00:00:00 2001
From: Ivo Gabe de Wolff <ivogabe@ivogabe.nl>
Date: Wed, 8 Mar 2023 16:42:38 +0100
Subject: [PATCH 49/62] Add simple schedule without task parallelism

---
 accelerate.cabal                              |   2 +
 src/Data/Array/Accelerate/AST/Operation.hs    |   2 +-
 .../Accelerate/AST/Schedule/Sequential.hs     | 199 ++++++++++++++++++
 src/Data/Array/Accelerate/Pretty/Operation.hs |   7 +-
 .../Accelerate/Pretty/Schedule/Sequential.hs  | 125 +++++++++++
 .../Accelerate/Pretty/Schedule/Uniform.hs     |   2 +-
 .../Accelerate/Trafo/Schedule/Uniform.hs      |   4 +-
 7 files changed, 336 insertions(+), 5 deletions(-)
 create mode 100644 src/Data/Array/Accelerate/AST/Schedule/Sequential.hs
 create mode 100644 src/Data/Array/Accelerate/Pretty/Schedule/Sequential.hs

diff --git a/accelerate.cabal b/accelerate.cabal
index adcb83c20..0669a61ef 100644
--- a/accelerate.cabal
+++ b/accelerate.cabal
@@ -400,6 +400,7 @@ library
         Data.Array.Accelerate.AST.Operation
         Data.Array.Accelerate.AST.Partitioned
         Data.Array.Accelerate.AST.Schedule
+        Data.Array.Accelerate.AST.Schedule.Sequential
         Data.Array.Accelerate.AST.Schedule.Uniform
         Data.Array.Accelerate.AST.Var
         Data.Array.Accelerate.Analysis.Hash
@@ -420,6 +421,7 @@ library
         Data.Array.Accelerate.Lifetime
         Data.Array.Accelerate.Pretty
         Data.Array.Accelerate.Pretty.Schedule
+        Data.Array.Accelerate.Pretty.Schedule.Sequential
         Data.Array.Accelerate.Pretty.Schedule.Uniform
         Data.Array.Accelerate.Representation.Array
         Data.Array.Accelerate.Representation.Elt
diff --git a/src/Data/Array/Accelerate/AST/Operation.hs b/src/Data/Array/Accelerate/AST/Operation.hs
index 6c3ae555e..b1dbd1e2d 100644
--- a/src/Data/Array/Accelerate/AST/Operation.hs
+++ b/src/Data/Array/Accelerate/AST/Operation.hs
@@ -40,7 +40,7 @@ module Data.Array.Accelerate.AST.Operation (
   expGroundVars, funGroundVars, arrayInstrsInExp, arrayInstrsInFun,
 
   encodeGroundR, encodeGroundsR, encodeGroundVar, encodeGroundVars,
-  rnfGroundR, rnfGroundsR, rnfGroundVar, rnfGroundVars,
+  rnfGroundR, rnfGroundsR, rnfGroundVar, rnfGroundVars, rnfUniqueness,
   liftGroundR, liftGroundsR, liftGroundVar, liftGroundVars,
 
   bufferImpossible, groundFunctionImpossible,
diff --git a/src/Data/Array/Accelerate/AST/Schedule/Sequential.hs b/src/Data/Array/Accelerate/AST/Schedule/Sequential.hs
new file mode 100644
index 000000000..588c127ec
--- /dev/null
+++ b/src/Data/Array/Accelerate/AST/Schedule/Sequential.hs
@@ -0,0 +1,199 @@
+{-# LANGUAGE EmptyCase            #-}
+{-# LANGUAGE GADTs                #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_HADDOCK hide #-}
+-- |
+-- Module      : Data.Array.Accelerate.AST.Schedule.Sequential
+-- Copyright   : [2008..2020] The Accelerate Team
+-- License     : BSD3
+--
+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
+-- Stability   : experimental
+-- Portability : non-portable (GHC extensions)
+--
+
+module Data.Array.Accelerate.AST.Schedule.Sequential (
+  SArg(..), SArgs,
+  module Operation,
+  Cluster,
+  SequentialSchedule(..),
+  SeqSchedule(..),
+  SeqScheduleFun(..)
+) where
+
+import Data.Array.Accelerate.AST.Exp
+import Data.Array.Accelerate.AST.Var
+import Data.Array.Accelerate.Type
+import Data.Array.Accelerate.Representation.Array
+import Data.Array.Accelerate.Representation.Shape
+import Data.Array.Accelerate.Representation.Type
+import Data.Array.Accelerate.AST.Var
+import Data.Array.Accelerate.AST.LeftHandSide
+import Data.Array.Accelerate.AST.Operation                          hiding (PreOpenAcc(..), PreOpenAfun(..))
+import qualified Data.Array.Accelerate.AST.Operation as Operation
+import Data.Array.Accelerate.AST.Partitioned                        hiding (PartitionedAcc, PartitionedAfun)
+import qualified Data.Array.Accelerate.AST.Partitioned as Partition
+import Data.Array.Accelerate.AST.Kernel
+import Data.Array.Accelerate.AST.Schedule
+import Data.Array.Accelerate.AST.Schedule.Uniform ( SArg(..), SArgs )
+import Data.Array.Accelerate.Trafo.Schedule.Uniform ( compileKernel', CompiledKernel(..), rnfSArg, rnfSArgs )
+import Data.Array.Accelerate.AST.Execute
+import Control.Concurrent.MVar
+import Data.Typeable                                                ( (:~:)(..) )
+import Data.Kind (Type)
+
+-- Generic schedule for a uniform memory space and uniform scheduling,
+-- without task parallelism.
+data SequentialSchedule kernel env t where
+  SequentialLam
+    :: GLeftHandSide s env env'
+    -> SequentialSchedule kernel env' t
+    -> SequentialSchedule kernel env  (s -> t)
+
+  SequentialBody
+    :: SeqSchedule        kernel env t
+    -> SequentialSchedule kernel env (MVar t -> ())
+
+data SeqSchedule (kernel :: (Type -> Type)) env t where
+  -- | Executes a kernel. Such a kernel does not return a
+  -- value, the effects of the execution are only visible by the mutation of
+  -- buffers which were annotated with either 'Mut' or 'Out'.
+  -- Provides the operation arguments from the environment.
+  --
+  Exec    :: KernelMetadata kernel f
+          -> KernelFun kernel args
+          -> SArgs env args
+          -> SeqSchedule kernel env ()
+
+  -- | Returns the values of the given variables.
+  --
+  Return  :: GroundVars env a
+          -> SeqSchedule kernel env a
+
+  -- | Evaluates the expression and returns its value.
+  --
+  Compute :: Exp env t
+          -> SeqSchedule kernel env t
+
+  -- | Local binding of ground values.
+  -- As it is common in this intermediate representation to evaluate some program
+  -- resulting in unit, for instance when execution some operation, and then
+  -- and then do some other code, we write 'a; b' to denote 'let () = a in b'.
+  Alet    :: GLeftHandSide bnd env env'
+          -> Uniquenesses bnd
+          -> SeqSchedule kernel env  bnd
+          -> SeqSchedule kernel env' t
+          -> SeqSchedule kernel env  t
+
+  -- | Allocates a new buffer of the given size.
+  --
+  Alloc   :: ShapeR sh
+          -> ScalarType e
+          -> ExpVars env sh
+          -> SeqSchedule op env (Buffer e)
+
+  -- | Buffer inlet. To pass an array constant in this data type, one may need
+  -- multiple 'Use' constructs because of the explicit Structure-of-Arrays.
+  -- Triggers (possibly) asynchronous host->device transfer if necessary.
+  --
+  Use     :: ScalarType e
+          -> Int -- Number of elements
+          -> Buffer e
+          -> SeqSchedule op env (Buffer e)
+
+  -- | Capture a scalar in a singleton buffer
+  --
+  Unit    :: ExpVar env e
+          -> SeqSchedule op env (Buffer e)
+
+  -- | If-then-else for array-level computations
+  --
+  Acond   :: ExpVar env PrimBool
+          -> SeqSchedule op env a
+          -> SeqSchedule op env a
+          -> SeqSchedule op env a
+
+  -- Value-recursion for array-level computations
+  -- The uniqueness guarantees are an invariant of the loop
+  -- and should hold before and after each iteration.
+  --
+  Awhile  :: Uniquenesses a
+          -> SeqScheduleFun op env (a -> PrimBool)
+          -> SeqScheduleFun op env (a -> a)
+          -> GroundVars     env a
+          -> SeqSchedule  op env a
+
+data SeqScheduleFun kernel env t where
+  Slam  :: GLeftHandSide s env env'
+        -> SeqScheduleFun kernel env' t
+        -> SeqScheduleFun kernel env  (s -> t)
+
+  Sbody :: SeqSchedule    kernel env t
+        -> SeqScheduleFun kernel env t
+
+instance IsSchedule SequentialSchedule where
+  -- 'a' is a ground type (ie, can be represented using GroundR)
+  type ScheduleInput  SequentialSchedule a = a
+  type ScheduleOutput SequentialSchedule a = MVar a
+
+  rnfSchedule (SequentialLam lhs f) = rnfLeftHandSide rnfGroundR lhs `seq` rnfSchedule f
+  rnfSchedule (SequentialBody body) = rnfSchedule' body
+
+  convertScheduleFun = convertScheduleFun'
+
+  callScheduledFun (GFunctionRbody repr) f
+    | Refl <- reprIsBody @SequentialSchedule repr = do
+      destination <- newEmptyMVar
+      f destination
+      takeMVar destination
+  callScheduledFun (GFunctionRlam _ ret) f = do
+    return $ \a -> do
+      callScheduledFun @SequentialSchedule ret $ f a
+
+convertScheduleFun'
+  :: IsKernel kernel
+  => Partition.PartitionedAfun (KernelOperation kernel) env t -> SequentialSchedule kernel env (Scheduled SequentialSchedule t)
+convertScheduleFun' (Operation.Alam lhs f) = SequentialLam lhs $ convertScheduleFun' f
+convertScheduleFun' (Operation.Abody body)
+  | Refl <- reprIsBody @SequentialSchedule $ groundsR body = SequentialBody $ convertSchedule' body
+
+convertSchedule' :: forall kernel env t. IsKernel kernel => Partition.PartitionedAcc (KernelOperation kernel) env t -> SeqSchedule kernel env t
+convertSchedule' (Operation.Exec op args)
+  | CompiledKernel kernel args' <- compileKernel' @env @kernel op args = Exec (kernelMetadata kernel) kernel args'
+convertSchedule' (Operation.Return vars) = Return vars
+convertSchedule' (Operation.Compute expr) = Compute expr
+convertSchedule' (Operation.Alet lhs us bnd expr) = Alet lhs us (convertSchedule' bnd) (convertSchedule' expr)
+convertSchedule' (Operation.Alloc shr tp sh) = Alloc shr tp sh
+convertSchedule' (Operation.Use tp n buffer) = Use tp n buffer
+convertSchedule' (Operation.Unit var) = Unit var
+convertSchedule' (Operation.Acond var true false) = Acond var (convertSchedule' true) (convertSchedule' false)
+convertSchedule' (Operation.Awhile us condition step initial) = Awhile us (convertScheduleFun'' condition) (convertScheduleFun'' step) initial
+
+convertScheduleFun'' :: forall kernel env t. IsKernel kernel => Partition.PartitionedAfun (KernelOperation kernel) env t -> SeqScheduleFun kernel env t
+convertScheduleFun'' (Operation.Alam lhs f) = Slam lhs $ convertScheduleFun'' f
+convertScheduleFun'' (Operation.Abody body) = Sbody $ convertSchedule' body
+
+rnfSchedule' :: IsKernel kernel => SeqSchedule kernel env t -> ()
+rnfSchedule' (Exec metadata kernel args) = rnf' metadata `seq` rnf' kernel `seq` rnfSArgs args
+rnfSchedule' (Return vars) = rnfGroundVars vars
+rnfSchedule' (Compute expr) = rnfOpenExp expr
+rnfSchedule' (Alet lhs us bnd expr)
+  = rnfLeftHandSide rnfGroundR lhs
+  `seq` rnfTupR rnfUniqueness us
+  `seq` rnfSchedule' bnd
+  `seq` rnfSchedule' expr
+rnfSchedule' (Alloc shr tp sh) = rnfShapeR shr `seq` rnfScalarType tp `seq` rnfTupR rnfExpVar sh
+rnfSchedule' (Use tp n buffer) = n `seq` buffer `seq` rnfScalarType tp
+rnfSchedule' (Unit var) = rnfExpVar var
+rnfSchedule' (Acond var true false) = rnfExpVar var `seq` rnfSchedule' true `seq` rnfSchedule' false
+rnfSchedule' (Awhile us condition step initial) = rnfTupR rnfUniqueness us `seq` rnfScheduleFun condition `seq` rnfScheduleFun step `seq` rnfGroundVars initial
+
+rnfScheduleFun :: IsKernel kernel => SeqScheduleFun kernel env t -> ()
+rnfScheduleFun (Slam lhs f) = rnfLeftHandSide rnfGroundR lhs `seq` rnfScheduleFun f
+rnfScheduleFun (Sbody body) = rnfSchedule' body
diff --git a/src/Data/Array/Accelerate/Pretty/Operation.hs b/src/Data/Array/Accelerate/Pretty/Operation.hs
index ea89288c6..9826b3634 100644
--- a/src/Data/Array/Accelerate/Pretty/Operation.hs
+++ b/src/Data/Array/Accelerate/Pretty/Operation.hs
@@ -23,9 +23,12 @@ module Data.Array.Accelerate.Pretty.Operation (
   PrettyOp(..),
   prettyAcc, prettyOpenAcc,
   prettyAfun, prettyOpenAfun,
-  prettyGroundR, Val'(..),
+  prettyGroundR, prettyGroundRWithUniqueness,
+  Val'(..), val, empty',
+  prettyVar, prettyVars,
   prettyArg, prettyShapeVars, prettyModifier, prettyBuffer,
-  prettyFun, prettyExp, prettyExp', prettyArrayInstr
+  prettyFun, prettyExp, prettyExp', prettyArrayInstr,
+  prettyGLhsWithTypes, prettyGLhsWithUniquenessTypes,
 ) where
 
 import Data.Array.Accelerate.Pretty.Exp
diff --git a/src/Data/Array/Accelerate/Pretty/Schedule/Sequential.hs b/src/Data/Array/Accelerate/Pretty/Schedule/Sequential.hs
new file mode 100644
index 000000000..5e22e134a
--- /dev/null
+++ b/src/Data/Array/Accelerate/Pretty/Schedule/Sequential.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE PatternGuards       #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE RecordWildCards     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE ViewPatterns        #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- |
+-- Module      : Data.Array.Accelerate.Pretty.Schedule.Sequential
+-- Copyright   : [2008..2020] The Accelerate Team
+-- License     : BSD3
+--
+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
+-- Stability   : experimental
+-- Portability : non-portable (GHC extensions)
+--
+
+module Data.Array.Accelerate.Pretty.Schedule.Sequential (
+
+) where
+
+import Data.Array.Accelerate.Pretty.Exp
+import Data.Array.Accelerate.Pretty.Type
+import Data.Array.Accelerate.Pretty.Schedule
+import Data.Array.Accelerate.AST.Kernel
+import Data.Array.Accelerate.AST.LeftHandSide
+import Data.Array.Accelerate.AST.Schedule.Sequential
+import Data.Array.Accelerate.Pretty.Operation
+import Data.Array.Accelerate.Representation.Type
+
+import Data.Text.Prettyprint.Doc
+
+import Prelude hiding (exp)
+
+instance PrettySchedule SequentialSchedule where
+  prettySchedule = prettySequentialSchedule empty'
+
+prettySequentialSchedule :: PrettyKernel kernel => Val' env -> SequentialSchedule kernel env t -> Adoc
+prettySequentialSchedule env (SequentialLam lhs f)
+  | (env', lhs') <- prettyGLhsWithTypes env lhs
+  = "\\" <> lhs' <+> "->" <> hardline <> indent 2 (prettySequentialSchedule env' f)
+prettySequentialSchedule env (SequentialBody sched)
+  = prettySeqSchedule env sched
+
+prettySeqScheduleFun :: PrettyKernel kernel => Val' env -> SeqScheduleFun kernel env t -> Adoc
+prettySeqScheduleFun env (Slam lhs f)
+  | (env', lhs') <- prettyGLhsWithTypes env lhs
+  = "\\" <> lhs' <+> "->" <> hardline <> indent 2 (prettySeqScheduleFun env' f)
+prettySeqScheduleFun env (Sbody sched)
+  = prettySeqSchedule env sched
+
+prettySeqSchedule :: forall kernel env t. PrettyKernel kernel => Val' env -> SeqSchedule kernel env t -> Adoc
+prettySeqSchedule env = \case
+  Exec _ kernel args -> prettyKernelFun env kernel args
+  Return vars -> hang 2 $ group $ vsep [annotate Statement "return", prettyVars (val env) 10 vars]
+  Compute exp -> hang 2 $ group $ vsep [annotate Statement "compute", prettyExp (val env) exp]
+  Alet LeftHandSideUnit _ bnd body
+    | notReturn bnd
+    -- A return looks very strange if there is no explict LHS. It's uncommon,
+    -- but also very strange when this does happens.
+    -> prettySeqSchedule env bnd
+        <> hardline
+        <> prettySeqSchedule env body
+  Alet lhs us bnd body
+    | (env', lhs') <- prettyGLhsWithUniquenessTypes env lhs us
+      -> hang 2 (group $ vsep [lhs' <+> "=", prettySeqSchedule env bnd])
+         <> hardline
+         <> prettySeqSchedule env' body
+  Alloc _ tp sh -> hang 2 $ group $ vsep [annotate Statement "alloc", prettyScalarType tp <> "[" <> prettyShapeVars (val env) sh <> "]"]
+  Use tp n buffer -> hang 2 $ group $ vsep [annotate Statement "use" <+> prettyScalarType tp <> "[" <> pretty n <> "]", prettyBuffer tp n buffer]
+  Unit var -> hang 2 $ group $ vsep [annotate Statement "unit", prettyVar (val env) var]
+  Acond c true false
+    -> group $ vsep
+        [ hang 2 $ group $ vsep
+          [ if_ <+> prettyVar (val env) c <+> then_
+          , prettySeqSchedule env true
+          ]
+        , hang 2 $ group $ vsep
+          [ else_
+          , prettySeqSchedule env false
+          ]
+        ]
+  Awhile us condition step initial
+    -> "awhile" <+> prettyTupR (const prettyGroundRWithUniqueness) 10 (groundsRWithUniquenesses (mapTupR varType initial) us)
+        <> hardline <> hang 4 ("  ( " <> prettySeqScheduleFun env condition)
+        <> hardline <> "  )"
+        <> hardline <> hang 4 ("  ( " <> prettySeqScheduleFun env step)
+        <> hardline <> "  )"
+        <> hardline <> indent 2 (prettyVars (val env) 10 initial)
+  where
+    notReturn Return{} = False
+    notReturn _        = True
+
+prettySArgs :: Val' benv -> SArgs benv f -> Adoc
+prettySArgs env args = tupled $ map (\(Exists a) -> prettySArg env a) $ argsToList args
+
+prettySArg :: Val' benv -> SArg benv t -> Adoc
+prettySArg env (SArgScalar var)   = prettyVar (val env) var
+prettySArg env (SArgBuffer m var) = prettyModifier m <+> prettyVar (val env) var
+
+prettyKernelFun :: forall kernel env f. PrettyKernel kernel => Val' env -> KernelFun kernel f -> SArgs env f -> Adoc
+prettyKernelFun env fun args = case prettyKernel of
+  PrettyKernelBody includeModifier prettyKernelBody ->
+    let
+      go :: Val kenv -> OpenKernelFun kernel kenv t -> SArgs env t -> Adoc
+      go kenv (KernelFunBody kernel) ArgsNil = prettyKernelBody kenv kernel
+      go kenv (KernelFunLam (KernelArgRscalar _) f) (SArgScalar a :>: as)
+        = go (Push kenv $ prettyVar (val env) a) f as
+      go kenv (KernelFunLam (KernelArgRbuffer _ _) f) (SArgBuffer mod' a :>: as) =
+        let
+          a'
+            | includeModifier = prettyModifier mod' <+> prettyVar (val env) a
+            | otherwise       = prettyVar (val env) a
+        in
+          go (Push kenv a') f as
+    in
+      go Empty fun args
+  PrettyKernelFun prettyKernelAsFun ->
+    prettyKernelAsFun fun
+      <> hardline <> indent 2 (prettySArgs env args)
diff --git a/src/Data/Array/Accelerate/Pretty/Schedule/Uniform.hs b/src/Data/Array/Accelerate/Pretty/Schedule/Uniform.hs
index d9cf2b44a..e222fd3b1 100644
--- a/src/Data/Array/Accelerate/Pretty/Schedule/Uniform.hs
+++ b/src/Data/Array/Accelerate/Pretty/Schedule/Uniform.hs
@@ -21,7 +21,7 @@
 --
 
 module Data.Array.Accelerate.Pretty.Schedule.Uniform (
-
+  prettySArg, prettySArgs, prettyKernelFun
 ) where
 
 import Data.Array.Accelerate.Pretty.Exp
diff --git a/src/Data/Array/Accelerate/Trafo/Schedule/Uniform.hs b/src/Data/Array/Accelerate/Trafo/Schedule/Uniform.hs
index 9a28e11de..7b0875317 100644
--- a/src/Data/Array/Accelerate/Trafo/Schedule/Uniform.hs
+++ b/src/Data/Array/Accelerate/Trafo/Schedule/Uniform.hs
@@ -27,7 +27,9 @@
 --
 
 module Data.Array.Accelerate.Trafo.Schedule.Uniform (
-  -- Only exports the instance IsSchedule UniformScheduleFun
+  -- Exports the instance IsSchedule UniformScheduleFun
+
+  compileKernel', CompiledKernel(..), rnfSArg, rnfSArgs
 ) where
 
 import Data.Array.Accelerate.Analysis.Match

From 4221a5d378a3800581273ff3b3b490e803ce5617 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Mon, 3 Apr 2023 11:38:34 +0200
Subject: [PATCH 50/62] update stack resolver

---
 stack.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index 3d78a397b..8a9751193 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -2,7 +2,7 @@
 # For advanced use and comprehensive documentation of the format, please see:
 # https://docs.haskellstack.org/en/stable/yaml_configuration/
 
-resolver: lts-20.12
+resolver: lts-20.16
 
 packages:
 - .

From 834601014aa7b10d074af954967ca54292a91a55 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Mon, 3 Apr 2023 11:39:04 +0200
Subject: [PATCH 51/62] build with ghc-9.6

---
 .github/workflows/ci.yml             | 2 ++
 accelerate.cabal                     | 2 +-
 cabal.project                        | 7 +++++++
 src/Data/Array/Accelerate/Orphans.hs | 2 +-
 4 files changed, 11 insertions(+), 2 deletions(-)
 create mode 100644 cabal.project

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index f9149dece..152454429 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -12,6 +12,7 @@ on:
       - '.github/workflows/ci.yml'
       - '*.cabal'
       - 'cabal.project'
+      - 'stack.yaml'
       - 'src/**'
       - 'test/**'
       - 'cbits/**'
@@ -35,6 +36,7 @@ jobs:
           - "ARM64"
         ghc:
           - 'latest'
+          - '9.6'
           - '9.4'
           - '9.2'
           - '9.0'
diff --git a/accelerate.cabal b/accelerate.cabal
index 3da8b21fe..8dde1bcf7 100644
--- a/accelerate.cabal
+++ b/accelerate.cabal
@@ -335,7 +335,7 @@ flag nofib
 
 library
   build-depends:
-          base                          >= 4.12 && < 4.18
+          base                          >= 4.12 && < 4.19
         , ansi-terminal                 >= 0.6.2
         , base-orphans                  >= 0.3
         , bytestring                    >= 0.10.2
diff --git a/cabal.project b/cabal.project
new file mode 100644
index 000000000..70587a9b8
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1,7 @@
+packages: .
+
+-- XXX: awaiting new release for ghc-9.6
+allow-newer:
+  hedgehog:template-haskell
+
+-- vim: nospell filetype=cabal
diff --git a/src/Data/Array/Accelerate/Orphans.hs b/src/Data/Array/Accelerate/Orphans.hs
index ea570dd0d..39a43d493 100644
--- a/src/Data/Array/Accelerate/Orphans.hs
+++ b/src/Data/Array/Accelerate/Orphans.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DataKinds                  #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving         #-}
-{-# LANGUAGE TypeInType                 #-}
 {-# LANGUAGE UnboxedTuples              #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- |

From b349b28e9bd9c0c6e0dd61481e4a037d08928e31 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Mon, 3 Apr 2023 11:51:07 +0200
Subject: [PATCH 52/62] update submodule tracy@v0.9.1

---
 Setup.hs    | 2 +-
 cbits/tracy | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/Setup.hs b/Setup.hs
index 600cb0795..b6c7be135 100755
--- a/Setup.hs
+++ b/Setup.hs
@@ -43,7 +43,7 @@ preConfHook args config_flags = do
            then rawSystemExit verbosity "git" ["submodule", "update", "--init", "--recursive"]
            else do
              -- XXX: This must be kept up to date with the git submodule revision
-             let archive = "v0.9.tar.gz"
+             let archive = "v0.9.1.tar.gz"
              createDirectoryIfMissing True "cbits/tracy"
              rawSystemExit verbosity "curl" ["-LO", "https://github.com/wolfpld/tracy/archive/refs/tags/" ++ archive]
              rawSystemExit verbosity "tar" ["-xzf", archive, "-C", "cbits/tracy", "--strip-components", "1"]
diff --git a/cbits/tracy b/cbits/tracy
index 5a1f5371b..897aec5b0 160000
--- a/cbits/tracy
+++ b/cbits/tracy
@@ -1 +1 @@
-Subproject commit 5a1f5371b792c12aea324213e1dc738b2923ae21
+Subproject commit 897aec5b062664d2485f4f9a213715d2e527e0ca

From 658cc60f6550196190549835f1abca3c48046b30 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 5 Apr 2023 11:49:04 +0200
Subject: [PATCH 53/62] update ci

---
 .github/workflows/ci.yml | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 152454429..4a2250a30 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -62,7 +62,7 @@ jobs:
       # condition, making it default to `post-if: always ()`.
       - name: Set up actions/cache-always@v3
         run: |
-          sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
+          sed -i'~' -e '/ post-if: /d' .github/actions/cache-always/action.yml
 
       - name: Set up Haskell
         uses: haskell/actions/setup@v2
@@ -90,9 +90,11 @@ jobs:
         shell: bash
 
       - name: Freeze
-        run: cabal freeze
+        run: |
+          cabal freeze
+          sed -i'~' -e '/^index-state:/d' cabal.project.freeze
 
-      - name: actions/cache-always@v3
+      - name: Run actions/cache-always@v3
         uses: ./.github/actions/cache-always
         with:
           path: |
@@ -150,7 +152,7 @@ jobs:
       # condition, making it default to `post-if: always ()`.
       - name: Set up actions/cache-always@v3
         run: |
-          sed -i -e '/ post-if: /d' .github/actions/cache-always/action.yml
+          sed -i'~' -e '/ post-if: /d' .github/actions/cache-always/action.yml
 
       - name: Set up Haskell
         uses: haskell/actions/setup@v2
@@ -159,7 +161,7 @@ jobs:
           enable-stack: true
           stack-no-global: true
 
-      - name: actions/cache-always@v3
+      - name: Run actions/cache-always@v3
         uses: ./.github/actions/cache-always
         with:
           path: |

From ea6ed7583ae5e7b0a4c93ee3aa9bb0159bd672ee Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Wed, 5 Apr 2023 12:36:04 +0200
Subject: [PATCH 54/62] =?UTF-8?q?ci:=20change=20in=20behaviour=20of=20?=
 =?UTF-8?q?=E2=80=98cabal=20haddock=E2=80=99?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

haskell/cabal#8725
---
 .github/workflows/ci.yml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 4a2250a30..35bb01eae 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -112,7 +112,8 @@ jobs:
         run: cabal build
 
       - name: Haddock
-        run: cabal haddock
+        # Behaviour of cabal haddock has changed for the worse: https://github.com/haskell/cabal/issues/8725
+        run: cabal haddock --disable-documentation
         if: matrix.mode == 'release'
 
       - name: Test doctest

From dbc3b3b1c8de9281ecc823f6d73d2cfaa81438b9 Mon Sep 17 00:00:00 2001
From: Tom Smeding <t.j.smeding@uu.nl>
Date: Fri, 14 Apr 2023 13:55:21 +0200
Subject: [PATCH 55/62] Fix Semigroup instance for Exp Maybe

Fixes #517
---
 accelerate.cabal                              |  1 +
 src/Data/Array/Accelerate/Data/Maybe.hs       |  2 +-
 .../Array/Accelerate/Test/NoFib/Issues.hs     |  3 ++
 .../Accelerate/Test/NoFib/Issues/Issue517.hs  | 45 +++++++++++++++++++
 4 files changed, 50 insertions(+), 1 deletion(-)
 create mode 100644 src/Data/Array/Accelerate/Test/NoFib/Issues/Issue517.hs

diff --git a/accelerate.cabal b/accelerate.cabal
index 8dde1bcf7..c3ed7ec3f 100644
--- a/accelerate.cabal
+++ b/accelerate.cabal
@@ -543,6 +543,7 @@ library
         Data.Array.Accelerate.Test.NoFib.Issues.Issue436
         Data.Array.Accelerate.Test.NoFib.Issues.Issue437
         Data.Array.Accelerate.Test.NoFib.Issues.Issue439
+        Data.Array.Accelerate.Test.NoFib.Issues.Issue517
 
   else
     cpp-options:
diff --git a/src/Data/Array/Accelerate/Data/Maybe.hs b/src/Data/Array/Accelerate/Data/Maybe.hs
index 14e8b2ade..305da9a71 100644
--- a/src/Data/Array/Accelerate/Data/Maybe.hs
+++ b/src/Data/Array/Accelerate/Data/Maybe.hs
@@ -135,7 +135,7 @@ instance (Monoid (Exp a), Elt a) => Monoid (Exp (Maybe a)) where
 
 instance (Semigroup (Exp a), Elt a) => Semigroup (Exp (Maybe a)) where
   ma <> mb = cond (isNothing ma) mb
-           $ cond (isNothing mb) mb
+           $ cond (isNothing mb) ma
            $ lift (Just (fromJust ma <> fromJust mb))
 
 instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Maybe a) where
diff --git a/src/Data/Array/Accelerate/Test/NoFib/Issues.hs b/src/Data/Array/Accelerate/Test/NoFib/Issues.hs
index 13073be14..dd28874f8 100644
--- a/src/Data/Array/Accelerate/Test/NoFib/Issues.hs
+++ b/src/Data/Array/Accelerate/Test/NoFib/Issues.hs
@@ -37,6 +37,7 @@ module Data.Array.Accelerate.Test.NoFib.Issues (
   module Data.Array.Accelerate.Test.NoFib.Issues.Issue436,
   module Data.Array.Accelerate.Test.NoFib.Issues.Issue437,
   module Data.Array.Accelerate.Test.NoFib.Issues.Issue439,
+  module Data.Array.Accelerate.Test.NoFib.Issues.Issue517,
 
 ) where
 
@@ -67,6 +68,7 @@ import Data.Array.Accelerate.Test.NoFib.Issues.Issue427
 import Data.Array.Accelerate.Test.NoFib.Issues.Issue436
 import Data.Array.Accelerate.Test.NoFib.Issues.Issue437
 import Data.Array.Accelerate.Test.NoFib.Issues.Issue439
+import Data.Array.Accelerate.Test.NoFib.Issues.Issue517
 
 
 test_issues :: RunN -> TestTree
@@ -96,5 +98,6 @@ test_issues runN =
     , test_issue436 runN
     , test_issue437 runN
     , test_issue439 runN
+    , test_issue517 runN
     ]
 
diff --git a/src/Data/Array/Accelerate/Test/NoFib/Issues/Issue517.hs b/src/Data/Array/Accelerate/Test/NoFib/Issues/Issue517.hs
new file mode 100644
index 000000000..0d92a9400
--- /dev/null
+++ b/src/Data/Array/Accelerate/Test/NoFib/Issues/Issue517.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE RankNTypes #-}
+-- |
+-- Module      : Data.Array.Accelerate.Test.NoFib.Issues.Issue439
+-- Copyright   : [2009..2020] The Accelerate Team
+-- License     : BSD3
+--
+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
+-- Stability   : experimental
+-- Portability : non-portable (GHC extensions)
+--
+-- https://github.com/AccelerateHS/accelerate/issues/517
+--
+
+module Data.Array.Accelerate.Test.NoFib.Issues.Issue517 (
+
+  test_issue517
+
+) where
+
+import Data.Array.Accelerate                              as A
+import Data.Array.Accelerate.Data.Semigroup               as A
+import Data.Array.Accelerate.Test.NoFib.Base
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+
+test_issue517 :: RunN -> TestTree
+test_issue517 runN
+  = testCase "517"
+  $ e1 @=? runN t1
+
+type Tup5 a = (a, a, a, a, a)
+
+e1 :: Scalar (Tup5 (Maybe (Max Float)))
+e1 = fromList Z [(Nothing, Just 2, Just 3, Just 5, Just 7)]
+
+t1 :: Acc (Scalar (Tup5 (Maybe (Max Float))))
+t1 = unit $
+  T5 (Nothing_ <> Nothing_)
+     (Nothing_ <> Just_ 2)
+     (Just_ 3 <> Nothing_)
+     (Just_ 4 <> Just_ 5)
+     (Just_ 7 <> Just_ 6)
+

From 450ed688318fc7e11b1398f1667bbe2d29f9a6b7 Mon Sep 17 00:00:00 2001
From: Tom Smeding <t.j.smeding@uu.nl>
Date: Tue, 13 Jun 2023 18:25:06 +0200
Subject: [PATCH 56/62] Show instances for TupR and LeftHandSide

---
 src/Data/Array/Accelerate/AST/LeftHandSide.hs | 16 ++++++++++------
 .../Array/Accelerate/Representation/Array.hs  |  5 -----
 .../Array/Accelerate/Representation/Type.hs   | 19 +++++++++----------
 3 files changed, 19 insertions(+), 21 deletions(-)

diff --git a/src/Data/Array/Accelerate/AST/LeftHandSide.hs b/src/Data/Array/Accelerate/AST/LeftHandSide.hs
index 994cd9e6f..91ec12646 100644
--- a/src/Data/Array/Accelerate/AST/LeftHandSide.hs
+++ b/src/Data/Array/Accelerate/AST/LeftHandSide.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE GADTs           #-}
-{-# LANGUAGE KindSignatures  #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RankNTypes      #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators   #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE PatternSynonyms       #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE StandaloneDeriving    #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeOperators         #-}
 {-# OPTIONS_HADDOCK hide #-}
 -- |
 -- Module      : Data.Array.Accelerate.AST.LeftHandSide
@@ -40,6 +42,8 @@ data LeftHandSide s v env env' where
     -> LeftHandSide s v2       env' env''
     -> LeftHandSide s (v1, v2) env  env''
 
+deriving instance (forall a. Show (s a)) => Show (LeftHandSide s v env env')
+
 pattern LeftHandSideUnit
     :: ()                   -- required
     => (env' ~ env, v ~ ()) -- provided
diff --git a/src/Data/Array/Accelerate/Representation/Array.hs b/src/Data/Array/Accelerate/Representation/Array.hs
index d61304e76..ee02c0ad5 100644
--- a/src/Data/Array/Accelerate/Representation/Array.hs
+++ b/src/Data/Array/Accelerate/Representation/Array.hs
@@ -74,11 +74,6 @@ formatArrayR :: Format r (ArrayR a -> r)
 formatArrayR = later $ \case
   ArrayR shR eR -> bformat ("Array DIM" % int % " " % formatTypeR) (rank shR) eR
 
-instance Show (TupR ArrayR e) where
-  show TupRunit           = "()"
-  show (TupRsingle aR)    = show aR
-  show (TupRpair aR1 aR2) = "(" ++ show aR1 ++ "," ++ show aR2 ++ ")"
-
 formatArraysR :: Format r (TupR ArrayR e -> r)
 formatArraysR = later $ \case
   TupRunit         -> "()"
diff --git a/src/Data/Array/Accelerate/Representation/Type.hs b/src/Data/Array/Accelerate/Representation/Type.hs
index 477f09a00..9b154133f 100644
--- a/src/Data/Array/Accelerate/Representation/Type.hs
+++ b/src/Data/Array/Accelerate/Representation/Type.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs             #-}
-{-# LANGUAGE LambdaCase        #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
-{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE StandaloneDeriving    #-}
+{-# LANGUAGE TemplateHaskell       #-}
 {-# OPTIONS_HADDOCK hide #-}
 -- |
 -- Module      : Data.Array.Accelerate.Representation.Type
@@ -43,10 +45,7 @@ data TupR s a where
   TupRsingle :: s a                  -> TupR s a
   TupRpair   :: TupR s a -> TupR s b -> TupR s (a, b)
 
-instance Show (TupR ScalarType a) where
-  show TupRunit       = "()"
-  show (TupRsingle t) = show t
-  show (TupRpair a b) = "(" ++ show a ++ "," ++ show b ++ ")"
+deriving instance (forall a. Show (s a)) => Show (TupR s t)
 
 formatTypeR :: Format r (TypeR a -> r)
 formatTypeR = later $ \case

From d310977438711240fcceeb73087409ab36c8aa2a Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Mon, 24 Jul 2023 11:59:20 +0200
Subject: [PATCH 57/62] update stack to lts-21 (ghc-9.4)

---
 stack.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index 8a9751193..254318e76 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -2,7 +2,7 @@
 # For advanced use and comprehensive documentation of the format, please see:
 # https://docs.haskellstack.org/en/stable/yaml_configuration/
 
-resolver: lts-20.16
+resolver: lts-21.4
 
 packages:
 - .

From f9eb010ed267357ae0e23d7ddf98186ef2ff5034 Mon Sep 17 00:00:00 2001
From: "Trevor L. McDonell" <trevor.mcdonell@gmail.com>
Date: Mon, 24 Jul 2023 12:12:34 +0200
Subject: [PATCH 58/62] update cabal.project

---
 cabal.project | 6 ------
 1 file changed, 6 deletions(-)

diff --git a/cabal.project b/cabal.project
index 70587a9b8..e6fdbadb4 100644
--- a/cabal.project
+++ b/cabal.project
@@ -1,7 +1 @@
 packages: .
-
--- XXX: awaiting new release for ghc-9.6
-allow-newer:
-  hedgehog:template-haskell
-
--- vim: nospell filetype=cabal

From f63deacb15a9edceb8bf738d8440875f67359442 Mon Sep 17 00:00:00 2001
From: Ivo Gabe de Wolff <ivogabe@ivogabe.nl>
Date: Mon, 4 Sep 2023 13:39:38 +0200
Subject: [PATCH 59/62] Add variant of test without objective

---
 src/Data/Array/Accelerate.hs       |  4 ++--
 src/Data/Array/Accelerate/Trafo.hs | 12 +++++++++---
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/src/Data/Array/Accelerate.hs b/src/Data/Array/Accelerate.hs
index 75af0b0ec..7fafc1120 100644
--- a/src/Data/Array/Accelerate.hs
+++ b/src/Data/Array/Accelerate.hs
@@ -430,7 +430,7 @@ module Data.Array.Accelerate (
   CShort, CUShort, CInt, CUInt, CLong, CULong, CLLong, CULLong,
   CChar, CSChar, CUChar,
 
-  test, module Data.Array.Accelerate.Backend
+  test, testWithObjective, module Data.Array.Accelerate.Backend
 ) where
 
 import Data.Array.Accelerate.Backend
@@ -453,7 +453,7 @@ import Data.Array.Accelerate.Language
 import Data.Array.Accelerate.Pattern
 import Data.Array.Accelerate.Pattern.TH
 import Data.Array.Accelerate.Prelude
-import Data.Array.Accelerate.Trafo (test)
+import Data.Array.Accelerate.Trafo (test, testWithObjective)
 import Data.Array.Accelerate.Pretty                                 () -- show instances
 import Data.Array.Accelerate.Smart
 import Data.Array.Accelerate.Sugar.Array                            ( Array, Arrays, Scalar, Vector, Matrix, Segments, fromFunction, fromFunctionM, toList, fromList )
diff --git a/src/Data/Array/Accelerate/Trafo.hs b/src/Data/Array/Accelerate/Trafo.hs
index e674e07a1..3ac3c2949 100644
--- a/src/Data/Array/Accelerate/Trafo.hs
+++ b/src/Data/Array/Accelerate/Trafo.hs
@@ -33,7 +33,7 @@ module Data.Array.Accelerate.Trafo (
   Function, EltFunctionR,
   convertExp, convertFun,
 
-  test, convertAccWithObj, convertAfunWithObj, convertAccBench, convertAfunBench,
+  test, testWithObjective, convertAccWithObj, convertAfunWithObj, convertAccBench, convertAfunBench,
 ) where
 
 import Data.Array.Accelerate.Sugar.Array                  ( ArraysR )
@@ -78,13 +78,19 @@ import Data.Array.Accelerate.Trafo.Partitioning.ILP.Solve (Objective(..))
 
 defaultObjective = IntermediateArrays
 
--- TODO: simplifications commented out, because they REMOVE PERMUTE
 test
+  :: forall sched kernel f. (Afunction f, DesugarAcc (KernelOperation kernel), Operation.SimplifyOperation (KernelOperation kernel), Operation.SLVOperation (KernelOperation kernel), Partitioning.MakesILP (KernelOperation kernel), Pretty.PrettyOp (KernelOperation kernel), Pretty.PrettyKernel kernel, IsSchedule sched, IsKernel kernel, Pretty.PrettySchedule sched, Operation.ShrinkArg (Partitioning.BackendClusterArg (KernelOperation kernel)))
+  => f
+  -> String
+test = testWithObjective @sched @kernel @f defaultObjective
+
+-- TODO: simplifications commented out, because they REMOVE PERMUTE
+testWithObjective
   :: forall sched kernel f. (Afunction f, DesugarAcc (KernelOperation kernel), Operation.SimplifyOperation (KernelOperation kernel), Operation.SLVOperation (KernelOperation kernel), Partitioning.MakesILP (KernelOperation kernel), Pretty.PrettyOp (KernelOperation kernel), Pretty.PrettyKernel kernel, IsSchedule sched, IsKernel kernel, Pretty.PrettySchedule sched, Operation.ShrinkArg (Partitioning.BackendClusterArg (KernelOperation kernel)))
   => Objective
   -> f
   -> String
-test obj f
+testWithObjective obj f
   = "OriginalAcc:\n"
   ++ Pretty.renderForTerminal (Pretty.prettyPreOpenAfun configPlain prettyOpenAcc Empty original)
   ++ "\n\nDesugared OperationAcc:\n"

From 9f9a82fb4d3748c016bdc98fa5825e12adfcf60e Mon Sep 17 00:00:00 2001
From: Ivo Gabe de Wolff <ivogabe@ivogabe.nl>
Date: Tue, 12 Sep 2023 23:09:22 +0200
Subject: [PATCH 60/62] Reimplement SLV This should reduce the overhead of this
 transformation, as it now requires fewer passes over the environment. The
 previous implementation required lots of weakening over all entries in the
 environment. This must still be tested on some sample inputs.

---
 src/Data/Array/Accelerate/AST/Environment.hs  |   6 +-
 src/Data/Array/Accelerate/AST/IdxSet.hs       |  18 +-
 src/Data/Array/Accelerate/Trafo/LiveVars.hs   | 812 ++++++++++--------
 .../Accelerate/Trafo/Operation/LiveVars.hs    | 107 +--
 .../Trafo/Schedule/Uniform/LiveVars.hs        |  57 +-
 5 files changed, 532 insertions(+), 468 deletions(-)

diff --git a/src/Data/Array/Accelerate/AST/Environment.hs b/src/Data/Array/Accelerate/AST/Environment.hs
index d15f0d241..fea9b3c53 100644
--- a/src/Data/Array/Accelerate/AST/Environment.hs
+++ b/src/Data/Array/Accelerate/AST/Environment.hs
@@ -53,9 +53,9 @@ data Env f env where
   Push  :: Env f env -> f t -> Env f (env, t)
 
 data PartialEnv f env where
-  PEnd   :: PartialEnv f env
-  PPush  :: PartialEnv f env -> f t -> PartialEnv f (env, t)
-  PNone  :: PartialEnv f env ->        PartialEnv f (env, t)
+  PEnd  :: PartialEnv f env
+  PPush :: PartialEnv f env -> f t -> PartialEnv f (env, t)
+  PNone :: PartialEnv f env ->        PartialEnv f (env, t)
 
 type Val = Env Identity
 
diff --git a/src/Data/Array/Accelerate/AST/IdxSet.hs b/src/Data/Array/Accelerate/AST/IdxSet.hs
index a2cace647..43930b5d7 100644
--- a/src/Data/Array/Accelerate/AST/IdxSet.hs
+++ b/src/Data/Array/Accelerate/AST/IdxSet.hs
@@ -18,14 +18,14 @@
 
 module Data.Array.Accelerate.AST.IdxSet (
   IdxSet(..),
-  member, varMember, intersect, union, unions, (\\), (>>=), insert, insertVar, skip, skip',
+  member, varMember, overlaps, intersect, union, unions, (\\), (>>=), insert, insertVar, skip, skip',
   push, empty, isEmpty, drop, drop', remove, partialEnvRemoveSet,
   fromList, fromList', fromVarList, fromVars, map,
-  singleton, singletonVar, first,
+  singleton, singletonVar, first, null,
   toList
 ) where
 
-import Prelude hiding (drop, (>>=), map)
+import Prelude hiding (drop, (>>=), map, null)
 
 import Data.Array.Accelerate.AST.Idx
 import Data.Array.Accelerate.AST.Var
@@ -43,6 +43,13 @@ member idx (IdxSet set) = isJust $ prjPartial idx set
 varMember :: Var s env t -> IdxSet env -> Bool
 varMember (Var _ idx) = member idx
 
+overlaps :: IdxSet env -> IdxSet env -> Bool
+overlaps (IdxSet (PPush _ _)) (IdxSet (PPush _ _)) = True
+overlaps (IdxSet (PPush a _)) (IdxSet (PNone b  )) = overlaps (IdxSet a) (IdxSet b)
+overlaps (IdxSet (PNone a  )) (IdxSet (PPush b _)) = overlaps (IdxSet a) (IdxSet b)
+overlaps (IdxSet (PNone a  )) (IdxSet (PNone b  )) = overlaps (IdxSet a) (IdxSet b)
+overlaps _ _ = False
+
 intersect :: IdxSet env -> IdxSet env -> IdxSet env
 intersect (IdxSet a) (IdxSet b) = IdxSet $ intersectPartialEnv (\_ _ -> Present) a b
 
@@ -129,5 +136,10 @@ first (IdxSet (PNone env))
   | Just (Exists idx) <- first (IdxSet env) = Just $ Exists $ SuccIdx idx
 first _                                     = Nothing
 
+null :: IdxSet env -> Bool
+null (IdxSet (PPush _ _)) = False
+null (IdxSet (PNone env)) = null (IdxSet env)
+null _ = True
+
 instance Show (IdxSet env) where
   showsPrec p = showsPrec p . fmap (\(Exists idx) -> idxToInt idx) . toList
diff --git a/src/Data/Array/Accelerate/Trafo/LiveVars.hs b/src/Data/Array/Accelerate/Trafo/LiveVars.hs
index 0b41ec288..a3fb3788a 100644
--- a/src/Data/Array/Accelerate/Trafo/LiveVars.hs
+++ b/src/Data/Array/Accelerate/Trafo/LiveVars.hs
@@ -23,67 +23,59 @@
 --
 
 module Data.Array.Accelerate.Trafo.LiveVars
-  ( ReEnv(..), reEnvIdx, reEnvIndices, reEnvIndices', reEnvVar, reEnvVars
-  , Liveness(..), dead, LivenessEnv, emptyLivenessEnv
-  , setLive, setIndicesLive, setVarsLive, setLivenessImplies, setLivenessImplications, isLive
-  , strengthenLiveness, dropLivenessEnv, pushLivenessEnv
-  , bind, BindLiveness(..), bindSub, BindLivenessSub(..)
-  , ReturnImplication(..), ReturnImplications, noReturnImplications
-  , strengthenReturnImplications, droppedReturnImplications, propagateReturnLiveness
-  , joinReturnImplications, joinReturnImplication
+  -- ANALYSIS
+  -- Liveness env
+  ( LivenessEnv, emptyLivenessEnv
+  , lEnvPush, lEnvPushLHS
+  -- Constraints
+  , addLiveImplies, addLiveImplications
+  , setLive, setIdxSetLive, setVarsLive
+  -- Strengthen liveness env
+  , lEnvStrengthen, lEnvStrengthenLHS, lEnvStrengthenLHSReturn, LHSLiveness
+  , ReturnImplication(..), ReturnImplications, returnImplicationsLive
+  , returnImplicationWeakenByLHS, returnImplicationsWeakenByLHS
+  , returnVars, returnIndices
+  -- Sub-tuples
   , SubTupR(..), subTupR, subTupRpair, subTupUnit, subTupPreserves, subTupDistribute
   , DeclareSubVars(..), declareSubVars, DeclareMissingVars(..), declareMissingVars
   , DeclareMissingDistributedVars(..), declareMissingDistributedVars
-  , LVAnalysis(..), LVAnalysisFun(..), LVAnalysis'(..), allDead, expectJust
+  -- TRANSFORMATION
+  -- Main types
+  , LVAnalysis(..), LVAnalysisFun(..), LVAnalysis'(..)
+  -- Index transformation
+  , ReEnv(..), reEnvIdx, reEnvIndices, reEnvIndices', reEnvVar, reEnvVars
+  -- Bindings
+  , bind, BindLiveness(..), bindSub, BindLivenessSub(..)
+  -- Utilities
+  , allDead, expectJust
   , subTupExp, subTupFun
-  , composeSubTupR, subTup, subTupDBuf) where
+  , composeSubTupR, subTup, subTupDBuf
+  ) where
+
+import Data.Maybe (fromMaybe, mapMaybe, isNothing)
+import Control.DeepSeq (NFData (rnf))
+import Data.Type.Equality
 
-import Data.Array.Accelerate.AST.Environment
-import Data.Array.Accelerate.AST.Exp
 import Data.Array.Accelerate.AST.Idx
 import Data.Array.Accelerate.AST.IdxSet ( IdxSet(..) )
-import qualified Data.Array.Accelerate.AST.IdxSet as IdxSet
 import Data.Array.Accelerate.AST.Var
 import Data.Array.Accelerate.AST.LeftHandSide
+import qualified Data.Array.Accelerate.AST.IdxSet as IdxSet
+import Data.Array.Accelerate.AST.Environment
+import Data.Array.Accelerate.AST.Exp
 import Data.Array.Accelerate.Representation.Type
+import Data.Array.Accelerate.Array.Buffer
 import Data.Array.Accelerate.Trafo.Var
 import Data.Array.Accelerate.Trafo.Exp.Substitution
 import Data.Array.Accelerate.Trafo.Substitution
-import Data.Array.Accelerate.Trafo.SkipEnvironment
 import Data.Array.Accelerate.Error
 
-import Control.DeepSeq (NFData (rnf))
-import Data.List (foldl', mapAccumR)
-import Data.Maybe
-import Data.Type.Equality
-import Data.Array.Accelerate.Array.Buffer
-
-data ReEnv env subenv where
-  ReEnvEnd  :: ReEnv () ()
-  ReEnvSkip :: ReEnv env subenv -> ReEnv (env, t) subenv
-  ReEnvKeep :: ReEnv env subenv -> ReEnv (env, t) (subenv, t)
-
-reEnvIdx :: ReEnv env subenv -> env :?> subenv
-reEnvIdx (ReEnvKeep _) ZeroIdx      = Just ZeroIdx
-reEnvIdx (ReEnvKeep r) (SuccIdx ix) = SuccIdx <$> reEnvIdx r ix
-reEnvIdx (ReEnvSkip r) (SuccIdx ix) = reEnvIdx r ix
-reEnvIdx _             _            = Nothing
-
-reEnvIndices :: ReEnv env subenv -> [Exists (Idx env)] -> [Exists (Idx subenv)]
-reEnvIndices re = mapMaybe $ \(Exists idx) -> Exists <$> reEnvIdx re idx
-
-reEnvIndices' :: ReEnv env subenv -> [Idx env t] -> [Idx subenv t]
-reEnvIndices' re = mapMaybe $ reEnvIdx re
-
-reEnvVar :: ReEnv env subenv -> Var s env t -> Maybe (Var s subenv t)
-reEnvVar re (Var tp idx) = Var tp <$> reEnvIdx re idx
-
-reEnvVars :: ReEnv env subenv -> Vars s env t -> Maybe (Vars s subenv t)
-reEnvVars re = traverseTupR $ reEnvVar re
+-- ANALYSIS
 
 -- During the analysis, a variable is either known to be live, or unknown
--- whether it is live or dead. In the last case, we store a list of implied
--- indices which are also live if this variable appears to be live.
+-- whether it is live or dead. In the last case, we store two sets:
+-- * 'implies': the set of variables that are live if this variable appears to be live
+-- * 'implied-by': if any implied-by variable is live, then this variable is live
 --
 -- Note that type argument 't' is not used, but it is needed to give Liveness
 -- the correct kind to be used in 'Env', as defined in 'LivenessEnv'.
@@ -92,350 +84,236 @@ data Liveness env t where
 
   -- Not sure if this is live, but if it is then the given set of indices is also live,
   -- i.e. the liveness of this variable implies the liveness of others.
-  Unknown :: IdxSet env -> Liveness env t
+  Unknown
+    :: IdxSet env -- implies
+    -> IdxSet env -- implied by
+    -> Liveness env t
 
 dead :: Liveness env t
-dead = Unknown IdxSet.empty
-
-instance Sink Liveness where
-  weaken _ Live        = Live
-  weaken k (Unknown s) = Unknown $ IdxSet.map (weaken k) s
-
-instance SEnvValue Liveness where
-  weakenSEnvValue _    Live        = Live
-  weakenSEnvValue skip (Unknown s) = Unknown $ skipWeakenIdxSet skip s
-
-  weakenSEnvValue' _    Live        = Live
-  weakenSEnvValue' skip (Unknown s) = Unknown $ skipWeakenIdxSet' skip s
-
-  strengthenSEnvValue :: forall env1 env2 t. SEnv Liveness env1 -> Skip env1 env2 -> Liveness env1 t -> Liveness env2 t
-  strengthenSEnvValue _   _    Live        = Live
-  strengthenSEnvValue env skip (Unknown s) = Unknown $ skipStrengthenIdxSet skip $ go s IdxSet.empty
-    where
-      skip' = skipReverse skip
-
-      go :: IdxSet env1 -> IdxSet env1 -> IdxSet env1
-      go set accum = foldl' (flip go') accum' $ IdxSet.toList dropped
-        where
-          accum' = IdxSet.union accum set
-          -- Find the indices in the set which will be removed when strengthening
-          -- from env1 to env2
-          dropped = skipTakeIdxSet' skip' set IdxSet.\\ accum
-
-      go' :: Exists (Idx env1) -> IdxSet env1 -> IdxSet env1
-      go' (Exists idx) accum = case sprj idx env of
-        Live -> accum
-        Unknown set -> go set accum
+dead = Unknown IdxSet.empty IdxSet.empty
 
-newtype LivenessEnv env = LivenessEnv (SEnv Liveness env)
+data LivenessEnv env where
+  LEmpty :: LivenessEnv ()
+  LPush
+    :: LivenessEnv env
+    -> Liveness env t
+    -> LivenessEnv (env, t)
 
 emptyLivenessEnv :: LivenessEnv ()
-emptyLivenessEnv = LivenessEnv SEmpty
-
-setLive :: forall env t. Idx env t -> LivenessEnv env -> LivenessEnv env
-setLive idx (LivenessEnv env) = foldl' (\e (Exists idx') -> setLive idx' e) (LivenessEnv env') implied
-  where
-    (env', implied) = sprjUpdate f idx env
-
-    f :: Liveness env t -> (Liveness env t, [Exists (Idx env)])
-    f Live = (Live, [])
-    f (Unknown i) = (Live, IdxSet.toList i)
+emptyLivenessEnv = LEmpty
 
-setIndicesLive :: [Exists (Idx env)] -> LivenessEnv env -> LivenessEnv env
-setIndicesLive indices env = foldl' (\e (Exists idx) -> setLive idx e) env indices
+lEnvPush :: LivenessEnv env -> LivenessEnv (env, t)
+lEnvPush env = LPush env dead
 
-setVarsLive :: Vars s env t -> LivenessEnv env -> LivenessEnv env
-setVarsLive vars env = foldl' (\e (Exists var) -> setLive (varIdx var) e) env $ flattenTupR vars
+lEnvPushLHS :: LeftHandSide s t env1 env2 -> LivenessEnv env1 -> LivenessEnv env2
+lEnvPushLHS (LeftHandSideSingle _)       env = lEnvPush env
+lEnvPushLHS (LeftHandSideWildcard _)     env = env
+lEnvPushLHS (LeftHandSidePair lhs1 lhs2) env = lEnvPushLHS lhs2 $ lEnvPushLHS lhs1 env
 
-setLivenessImplies :: Idx env t -> IdxSet env -> LivenessEnv env -> LivenessEnv env
-setLivenessImplies idx implied (LivenessEnv env)
-  | live = foldl' (\e (Exists idx') -> setLive idx' e) (LivenessEnv env') $ IdxSet.toList implied
-  | otherwise = LivenessEnv env'
+-- If idx1 is live, then idx2 is live
+addLiveImplies :: Idx env s -> Idx env t -> LivenessEnv env -> LivenessEnv env
+addLiveImplies = \idx1 idx2 env -> fromMaybe (setLive idx2 env) $ go idx1 idx2 env
   where
-    (env', live) = sprjUpdate f idx env
-    f Live = (Live, True)
-    f (Unknown implied') = (Unknown $ IdxSet.union implied implied', False)
-
-
-setLivenessImplications :: IdxSet env -> IdxSet env -> LivenessEnv env -> LivenessEnv env
-setLivenessImplications indices implied env = foldl' (\e (Exists idx) -> setLivenessImplies idx implied e) env $ IdxSet.toList indices
-
-isLive :: LivenessEnv env -> Idx env t -> Bool
-isLive (LivenessEnv env) idx
-  | Live <- sprj idx env = True
-  | otherwise            = False
-
-strengthenLiveness :: forall env' env t. LivenessEnv env' -> env' :?> env -> Liveness env' t -> Liveness env t
-strengthenLiveness env k (Unknown implies) = Unknown implies'
+    go :: Idx env s -> Idx env t -> LivenessEnv env -> Maybe (LivenessEnv env)
+    go ZeroIdx ZeroIdx env = Just env -- Trivial constraint, always satisfied
+    go (SuccIdx idx1) (SuccIdx idx2) (LPush env l) = (`LPush` l) <$> go idx1 idx2 env
+    go ZeroIdx (SuccIdx idx) (LPush env l) = case l of
+      Live -> Nothing
+      Unknown implies impliedBy ->
+        Just $ LPush env $ Unknown (IdxSet.insert idx implies) impliedBy
+    go (SuccIdx idx) ZeroIdx (LPush env l)
+      | isLive idx env = Nothing
+      | otherwise = case l of
+          Live -> Just $ LPush env Live
+          Unknown implies impliedBy ->
+            Just $ LPush env $ Unknown implies $ IdxSet.insert idx impliedBy
+
+-- If any of impliedBy becomes live, then implies are live.
+addLiveImplications :: IdxSet env -> IdxSet env -> LivenessEnv env -> LivenessEnv env
+addLiveImplications impliedBy implies (LPush env l)
+  | not (ZeroIdx `IdxSet.member` impliedBy || ZeroIdx `IdxSet.member` implies)
+  = LPush (addLiveImplications (IdxSet.drop impliedBy) (IdxSet.drop implies) env) l
+addLiveImplications impliedBy implies env
+  | anyIsLive impliedBy env
+  = setIdxSetLive implies env
+addLiveImplications impliedBy implies env
+  = addLiveImplicationsCurrentlyUnknown impliedBy implies env
+
+-- If any of impliedBy becomes live, then implies are live.
+-- Assumes that all indices in impliedBy are currently Unknown.
+addLiveImplicationsCurrentlyUnknown :: IdxSet env -> IdxSet env -> LivenessEnv env -> LivenessEnv env
+-- Base case / Early out
+addLiveImplicationsCurrentlyUnknown (IdxSet PEnd) _ env = env
+addLiveImplicationsCurrentlyUnknown _ (IdxSet PEnd) env = env
+-- Recursive
+addLiveImplicationsCurrentlyUnknown impliedBy implies (LPush env l) = LPush (addLiveImplicationsCurrentlyUnknown (IdxSet.drop impliedBy) (IdxSet.drop implies) env) l'
   where
-    ReturnImplication implies' = strengthenReturnImplications env k $ ReturnImplication implies
-strengthenLiveness _   _ Live = Live
-
-strengthenReturnImplications :: forall env' env t. LivenessEnv env' -> env' :?> env -> ReturnImplication env' t -> ReturnImplication env t
-strengthenReturnImplications (LivenessEnv env) k (ReturnImplication implies) = ReturnImplication $ snd $ goSet IdxSet.empty implies
+    l' = case l of
+      Unknown implies' impliedBy' ->
+        Unknown
+          (if ZeroIdx `IdxSet.member` impliedBy
+            then IdxSet.drop implies `IdxSet.union` implies'
+            else implies')
+          (if ZeroIdx `IdxSet.member` implies
+            then IdxSet.drop impliedBy `IdxSet.union` impliedBy'
+            else impliedBy')
+      Live 
+        | ZeroIdx `IdxSet.member` impliedBy -> error "`Unknown` may not point to an already live variable"
+        | otherwise -> Live
+
+setLive :: Idx env s -> LivenessEnv env -> LivenessEnv env
+setLive = \idx env -> uncurry setIdxSetLive $ go idx env
   where
-    go :: IdxSet env' -> Idx env' s -> (IdxSet env', IdxSet env)
-    go visited idx
-      | Just idx' <- k idx = (visited, IdxSet.singleton idx')
-      | Unknown implies' <- sprj idx env = goSet visited implies'
-      | otherwise = (visited, IdxSet.empty)
-
-    goSet :: IdxSet env' -> IdxSet env' -> (IdxSet env', IdxSet env)
-    goSet visited set = (visited'', IdxSet.unions implied)
+    go :: Idx env s -> LivenessEnv env -> (IdxSet env, LivenessEnv env)
+    go (SuccIdx idx) (LPush env l) = case l of
+      Live -> (IdxSet.skip newSet, LPush env' Live)
+      Unknown implies impliedBy
+        | idx `IdxSet.member` impliedBy ->
+          (IdxSet.skip $ implies `IdxSet.union` newSet, LPush env' Live)
+        | otherwise ->
+          (IdxSet.skip $ newSet, LPush env' $ Unknown (IdxSet.remove idx implies) impliedBy)
       where
-        set' = set IdxSet.\\ visited
-        visited' = visited `IdxSet.union` set
-        (visited'', implied) = mapAccumR (\v (Exists idx) -> go v idx) visited' (IdxSet.toList set')
-
-
-droppedReturnImplications :: LeftHandSide s t env env' -> ReturnImplication env' v -> ReturnImplication env' v
-droppedReturnImplications lhs (ReturnImplication implies) = ReturnImplication $ IdxSet.intersect implies $ lhsIndices lhs
-
-dropLivenessEnv :: forall s t env env'. LeftHandSide s t env env' -> LivenessEnv env' -> LivenessEnv env
-dropLivenessEnv lhs (LivenessEnv env) = LivenessEnv $ strengthenSEnv (lhsSkip' lhs) env
-
-pushLivenessEnv :: forall s t env env'. LeftHandSide s t env env' -> ReturnImplications env t -> LivenessEnv env -> LivenessEnv env'
-pushLivenessEnv lhs bodyImplications (LivenessEnv env) = LivenessEnv $ go lhs bodyImplications $ weakenSEnv (lhsSkip' lhs) env
-  where
-    go :: LeftHandSide s t' env1 env2 -> ReturnImplications env t' -> SEnv' Liveness env' env1 -> SEnv' Liveness env' env2
-    go (LeftHandSideSingle _)   (TupRsingle (ReturnImplication set)) e = SPush e $ Unknown $ IdxSet.skip' lhs set
-    go (LeftHandSideWildcard _) _                                    e = e
-    go (LeftHandSidePair l1 l2) (TupRpair i1 i2)                     e = go l2 i2 $ go l1 i1 e
-    go (LeftHandSidePair l1 l2) (TupRsingle (ReturnImplication set)) e = go l2 (TupRsingle $ ReturnImplication set) $ go l1 (TupRsingle $ ReturnImplication set) e
-    go _                        _                                    _ = internalError "Tuple mismatch"
-
--- Similar to LeftHandSide, but LeftHandSideSingle is annotated with a boolean
--- denoting whether the variable is live.
---
-data LHSLiveness s t env env' where
-  LHSLivenessWildcard :: TupR s t -> LHSLiveness s t env env
-  LHSLivenessSingle   :: Bool -> s t -> LHSLiveness s t env (env, t)
-  LHSLivenessPair     :: LHSLiveness s t1 env env'
-                      -> LHSLiveness s t2 env' env''
-                      -> LHSLiveness s (t1, t2) env env''
-
--- Creates an LHSLiveness where the bindings with Live are marked as live.
--- Note that in 'bind' we still need to mark more bindings live, as they
--- can be implied by live free variables (following from ReEnv).
---
-envToLHSLiveness
-  :: SEnv' Liveness env'' env'
-  -> LeftHandSide s t env env'
-  -> (SEnv' Liveness env'' env, LHSLiveness s t env env')
-envToLHSLiveness env (LeftHandSideWildcard tp) = (env, LHSLivenessWildcard tp)
-envToLHSLiveness env (LeftHandSideSingle tp)   = (env', LHSLivenessSingle live tp)
-  where
-    (env', v) = senvTop env
-    live
-      | Live <- v = True
-      | otherwise = False
-envToLHSLiveness env (LeftHandSidePair l1 l2)  = (env'', LHSLivenessPair l1' l2')
-  where
-    (env',  l2') = envToLHSLiveness env  l2
-    (env'', l1') = envToLHSLiveness env' l1
-
-propagateLiveness :: SEnv' Liveness env' env -> ReEnv env subenv -> Skip' env' env -> LHSLiveness s t env env' -> LHSLiveness s t env env'
-propagateLiveness env re skip lhs = snd $ lhsMarkLive (reEnvImpliedLiveness env re skip) lhs
-
--- Returns the set of indices between env' and env1 which are implied to be
--- live by the variables which were not known to be live in the SEnv but are
--- live according to the ReEnv.
--- Only indices between env' and env1 (as specified by Skip) are returned. This
--- is used by propagateLiveness to only gather the freshly bound indices in the
--- LeftHandSide. Initially, Skip env' env1 will then correspond with
--- `LeftHandSide s t env1 env'`; but env' will change in recursive calls of
--- this function. By only returning a set of the indices in this range, we not
--- only reduce the cost of unions, but we can now also stop the recursion
--- earlier when we have found (enough) SSkips as we are then guaranteed that we
--- don't find new implied indices in the range.
---
-reEnvImpliedLiveness :: SEnv' Liveness env' env -> ReEnv env subenv -> Skip' env' env1 -> IdxSet env'
-reEnvImpliedLiveness (SSkip skip' env)             re             skip = case joinSkips' skip skip' of
-  Right _ -> IdxSet.empty -- No need to traverse further
-  Left skip'' -> skipWeakenIdxSet' skip' $ reEnvImpliedLiveness env re skip''
-reEnvImpliedLiveness (SPush env _)                 (ReEnvSkip re) skip
-  -- Variable is not live
-  = reEnvImpliedLiveness env re skip
-reEnvImpliedLiveness (SPush env (Unknown implied)) (ReEnvKeep re) skip
-  -- Variable became live, propagate liveness
-  = skipTakeIdxSet' skip implied `IdxSet.union` reEnvImpliedLiveness env re skip
-reEnvImpliedLiveness (SPush env Live)              (ReEnvKeep re) skip
-  -- Variable was already live, no need to propagate new liveness information
-  = reEnvImpliedLiveness env re skip
-reEnvImpliedLiveness SEmpty                        ReEnvEnd       _    = IdxSet.empty
-
-lhsMarkLive :: IdxSet env' -> LHSLiveness s t env env' -> (IdxSet env, LHSLiveness s t env env')
-lhsMarkLive (IdxSet PEnd) lhs
-  = (IdxSet PEnd, lhs)
-lhsMarkLive (IdxSet set)  (LHSLivenessSingle live1 tp)
-  = (IdxSet set', LHSLivenessSingle (live1 || live2) tp)
-  where
-    (live2, set') = case set of
-      PPush s _ -> (True,  s)
-      PNone s   -> (False, s)
-      PEnd      -> (False, PEnd)
-lhsMarkLive set           (LHSLivenessWildcard tp)
-  = (set, LHSLivenessWildcard tp)
-lhsMarkLive set           (LHSLivenessPair l1 l2)
-  = (set'', LHSLivenessPair l1' l2')
-  where
-    (set',  l2') = lhsMarkLive set l2
-    (set'', l1') = lhsMarkLive set' l1
-
-bind :: LeftHandSide s t env env' -> ReEnv env subenv -> LivenessEnv env' -> BindLiveness s t env' subenv
-bind lhs re (LivenessEnv env) = go lhs2 re
-  where
-    (env', lhs1) = envToLHSLiveness env lhs
-    lhs2 = propagateLiveness env' re (lhsSkip' lhs) lhs1
-
-    go :: LHSLiveness s t env1 env2 -> ReEnv env1 subenv1 -> BindLiveness s t env2 subenv1
-    go (LHSLivenessWildcard tp)     re' = BindLiveness (LeftHandSideWildcard tp) re'
-    go (LHSLivenessSingle True  tp) re' = BindLiveness (LeftHandSideSingle tp) (ReEnvKeep re')
-    go (LHSLivenessSingle False tp) re' = BindLiveness (LeftHandSideWildcard $ TupRsingle tp) (ReEnvSkip re')
-    go (LHSLivenessPair l1 l2)      re'
-      | BindLiveness l1' re''  <- go l1 re'
-      , BindLiveness l2' re''' <- go l2 re''
-      = BindLiveness (leftHandSidePair l1' l2') re'''
-
--- Captures the existentional subenv'
-data BindLiveness s t env' subenv where
-  BindLiveness
-    :: LeftHandSide s t subenv subenv'
-    -> ReEnv env' subenv'
-    -> BindLiveness s t env' subenv
-
-bindSub :: LeftHandSide s t env env' -> ReEnv env subenv -> LivenessEnv env' -> BindLivenessSub s t env' subenv
-bindSub lhs re (LivenessEnv env) = go lhs2 re
+        (newSet, env') = go idx env
+    go ZeroIdx (LPush env l) = case l of
+      Live -> (IdxSet.empty, LPush env Live)
+      Unknown implies _ -> (IdxSet.skip implies, LPush env Live)
+
+setIdxSetLive :: IdxSet env -> LivenessEnv env -> LivenessEnv env
+setIdxSetLive = \set env ->
+  if IdxSet.null set then env else uncurry setIdxSetLive $ go set env
   where
-    (env', lhs1) = envToLHSLiveness env lhs
-    lhs2 = propagateLiveness env' re (lhsSkip' lhs) lhs1
-
-    go :: LHSLiveness s t env1 env2 -> ReEnv env1 subenv1 -> BindLivenessSub s t env2 subenv1
-    go (LHSLivenessWildcard TupRunit) re' = BindLivenessSub SubTupRkeep (LeftHandSideWildcard TupRunit) (LeftHandSideWildcard TupRunit) re'
-    go (LHSLivenessWildcard tp)       re' = BindLivenessSub SubTupRskip (LeftHandSideWildcard tp) (LeftHandSideWildcard TupRunit) re'
-    go (LHSLivenessSingle True  tp)   re' = BindLivenessSub SubTupRkeep (LeftHandSideSingle tp) (LeftHandSideSingle tp) (ReEnvKeep re')
-    go (LHSLivenessSingle False tp)   re' = BindLivenessSub SubTupRskip (LeftHandSideWildcard $ TupRsingle tp) (LeftHandSideWildcard TupRunit) (ReEnvSkip re')
-    go (LHSLivenessPair l1 l2)        re'
-      | BindLivenessSub subTup1 l1' l1'' re''  <- go l1 re'
-      , BindLivenessSub subTup2 l2' l2'' re''' <- go l2 re''
-      = if
-          | LeftHandSideWildcard _ <- l1''
-          , LeftHandSideWildcard _ <- l2''
-          -> BindLivenessSub SubTupRskip (leftHandSidePair l1' l2') (LeftHandSideWildcard TupRunit) re'''
-
-          | SubTupRkeep <- subTup1
-          , SubTupRkeep <- subTup2
-          -> BindLivenessSub SubTupRkeep (leftHandSidePair l1' l2') (LeftHandSidePair l1'' l2'') re'''
-
-          | otherwise
-          -> BindLivenessSub (SubTupRpair subTup1 subTup2) (leftHandSidePair l1' l2') (LeftHandSidePair l1'' l2'') re'''
-
-propagateReturnLiveness :: SubTupR t t' -> ReturnImplications env t -> LivenessEnv env -> LivenessEnv env
-propagateReturnLiveness SubTupRskip         _                env = env
-propagateReturnLiveness SubTupRkeep         ret              env
-  = foldl' (\e (Exists (ReturnImplication set)) -> setIndicesLive (IdxSet.toList set) e) env $ flattenTupR ret
-propagateReturnLiveness (SubTupRpair s1 s2) (TupRpair r1 r2) env
-  = propagateReturnLiveness s1 r1 $ propagateReturnLiveness s2 r2 env
-propagateReturnLiveness (SubTupRpair _ _)   _                _   = internalError "Pair impossible"
-
--- Captures the existentionals subenv' and t'
-data BindLivenessSub s t env' subenv where
-  BindLivenessSub
-    :: SubTupR t t'
-    -> LeftHandSide s t  subenv subenv'
-    -> LeftHandSide s t' subenv subenv'
-    -> ReEnv env' subenv'
-    -> BindLivenessSub s t env' subenv
-
-data DeclareSubVars s t t' env where
-  DeclareSubVars :: LeftHandSide s t env env'
-                 -> (env :> env')
-                 -> (forall env''. env' :> env'' -> Vars s env'' t')
-                 -> DeclareSubVars s t t' env
-
-declareSubVars :: TupR s t -> SubTupR t t' -> DeclareSubVars s t t' env
-declareSubVars tp SubTupRkeep
-  | DeclareVars lhs k vars <- declareVars tp = DeclareSubVars lhs k vars
-declareSubVars tp SubTupRskip
-  = DeclareSubVars (LeftHandSideWildcard tp) weakenId (const TupRunit)
-declareSubVars (TupRpair t1 t2) (SubTupRpair s1 s2)
-  | DeclareSubVars lhs1 subst1 a1 <- declareSubVars t1 s1
-  , DeclareSubVars lhs2 subst2 a2 <- declareSubVars t2 s2
-  = DeclareSubVars (LeftHandSidePair lhs1 lhs2) (subst2 .> subst1) $ \k -> a1 (k .> subst2) `TupRpair` a2 k
-declareSubVars _ _ = internalError "Tuple mismatch"
-
-data DeclareMissingVars s t t' env where
-  -- Captures existentials env' and t''.
-  DeclareMissingVars :: LeftHandSide s t'' env env'
-                     -> (env :> env')
-                     -> (forall env''. env' :> env'' -> Vars s env'' t)
-                     -> DeclareMissingVars s t t' env
-
-declareMissingVars :: TupR s t -> SubTupR t t' -> Vars s env t' -> DeclareMissingVars s t t' env
-declareMissingVars _  SubTupRkeep vars = DeclareMissingVars (LeftHandSideWildcard TupRunit) weakenId (\k -> mapTupR (weaken k) vars)
-declareMissingVars tp SubTupRskip _
-  | DeclareVars lhs k value <- declareVars tp
-  = DeclareMissingVars lhs k value
-declareMissingVars (TupRpair t1 t2) (SubTupRpair s1 s2) (TupRpair v1 v2)
-  | DeclareMissingVars lhs1 subst1 value1 <- declareMissingVars t1 s1 v1
-  , DeclareMissingVars lhs2 subst2 value2 <- declareMissingVars t2 s2 (mapTupR (weaken subst1) v2)
-  = DeclareMissingVars (LeftHandSidePair lhs1 lhs2) (subst2 .> subst1) $ \k -> value1 (k .> subst2) `TupRpair` value2 k
-declareMissingVars _ _ _ = internalError "Tuple mismatch"
-
-data DeclareMissingDistributedVars f s' s t t' env where
-  -- Captures existentials env' and t''.
-  DeclareMissingDistributedVars
-    :: TupR s' t''
-    -> LeftHandSide s (Distribute f t'') env env'
-    -> (env :> env')
-    -> (forall env''. env' :> env'' -> Vars s env'' (Distribute f t))
-    -> DeclareMissingDistributedVars f s' s t t' env
-
--- 'f' is ambiguous
-declareMissingDistributedVars
-  :: forall f s' s t t' env.
-     TupR s' t -> TupR s (Distribute f t) -> SubTupR t t' -> Vars s env (Distribute f t') -> DeclareMissingDistributedVars f s' s t t' env
-declareMissingDistributedVars _ _ SubTupRkeep vars
-  = DeclareMissingDistributedVars TupRunit (LeftHandSideWildcard TupRunit) weakenId (\k -> mapTupR (weaken k) vars)
-declareMissingDistributedVars tp tp' SubTupRskip _
-  | DeclareVars lhs k value <- declareVars tp'
-  = DeclareMissingDistributedVars tp lhs k value
-declareMissingDistributedVars (TupRpair t1 t2) (TupRpair t1' t2') (SubTupRpair s1 s2) (TupRpair v1 v2)
-  | DeclareMissingDistributedVars st1 lhs1 subst1 value1 <- declareMissingDistributedVars @f t1 t1' s1 v1
-  , DeclareMissingDistributedVars st2 lhs2 subst2 value2 <- declareMissingDistributedVars @f t2 t2' s2 (mapTupR (weaken subst1) v2)
-  = DeclareMissingDistributedVars (TupRpair st1 st2) (LeftHandSidePair lhs1 lhs2) (subst2 .> subst1) $ \k -> value1 (k .> subst2) `TupRpair` value2 k
-declareMissingDistributedVars _ _ _ _ = internalError "Tuple mismatch"
-
-
--- For an IR parameterized over the result type, implement a function of this
--- type:
---
--- stronglyLiveVariables :: LivenessEnv env -> SomeAcc env t -> LVAnalysis SomeAcc env t
---
--- If the IR does have a result type, but we cannot change that type, then use:
---
--- stronglyLiveVariables :: LivenessEnv env -> SomeAcc env t -> LVAnalysisFun SomeAcc env t
---
--- For an IR which is not parameterized over the result type, but only over the
--- environment, implement a function of this type:
---
--- stronglyLiveVariables :: LivenessEnv env -> SomeAcc env -> LVAnalysis' SomeAcc env
+    go :: IdxSet env -> LivenessEnv env -> (IdxSet env, LivenessEnv env)
+    go (IdxSet PEnd) env = (IdxSet.empty, env)
+    go liveSet (LPush env l) = case l of
+      Live -> (IdxSet.skip newSet, LPush env' Live)
+      Unknown implies impliedBy
+        -- Does this variable become live?
+        | ZeroIdx `IdxSet.member` liveSet || IdxSet.overlaps tailLiveSet impliedBy ->
+          (IdxSet.skip $ implies `IdxSet.union` newSet, LPush env' Live)
+        | otherwise ->
+          (IdxSet.skip newSet, LPush env' $ Unknown (implies IdxSet.\\ tailLiveSet) impliedBy)
+      where
+        tailLiveSet = IdxSet.drop liveSet
+        (newSet, env') = go tailLiveSet env
 
--- If this part of the returned value is returned, then this set of variables is live
-newtype ReturnImplication env t = ReturnImplication (IdxSet env)
+setVarsLive :: Vars s env t -> LivenessEnv env -> LivenessEnv env
+setVarsLive = setIdxSetLive . IdxSet.fromVars
+
+isLive :: Idx env t -> LivenessEnv env -> Bool
+isLive (SuccIdx idx) (LPush env _) = isLive idx env
+isLive ZeroIdx       (LPush _   l) = case l of
+  Live -> True
+  _ -> False
+
+anyIsLive :: IdxSet env -> LivenessEnv env -> Bool
+anyIsLive (IdxSet PEnd) _ = False
+anyIsLive indices (LPush env Live)
+  | ZeroIdx `IdxSet.member` indices = True
+anyIsLive indices (LPush env _) = anyIsLive (IdxSet.drop indices) env
+
+-- Drops one entry of the liveness env.
+-- Propagates the constraints imposed by the first entry on the remaining entries in the environment.
+-- Returns Nothing if this variable is definitely live, or Just impliedBy if it is only live if one of the indices in impliedBy is live.
+lEnvStrengthen :: LivenessEnv (env1, t) -> (Maybe (IdxSet env1), LivenessEnv env1)
+lEnvStrengthen = \case
+  LPush env Live -> (Nothing, env)
+  LPush env (Unknown implies impliedBy) -> (Just impliedBy, addLiveImplicationsCurrentlyUnknown impliedBy implies env)
+
+-- Extension of LeftHandSide
+-- Data structure to remember data between a call to 'lEnvStrengthenLHS' and 'bind'
+data LHSLiveness s t env1 env2 where
+  LHSLivenessSingle
+    :: Maybe (IdxSet env1) -- Nothing if it is definitely live, or Just impliedBy if it is only live if one of the indices in impliedBy is live.
+    -> s t
+    -> LHSLiveness s t env1 (env1, t)
+  LHSLivenessWildcard
+    :: TupR s t
+    -> LHSLiveness s t env1 env1
+  LHSLivenessPair
+    :: LHSLiveness s t1       env1 env2
+    -> LHSLiveness s t2       env2 env3
+    -> LHSLiveness s (t1, t2) env1 env3
+
+lEnvStrengthenLHS :: LeftHandSide s t env1 env2 -> LivenessEnv env2 -> (LHSLiveness s t env1 env2, LivenessEnv env1)
+lEnvStrengthenLHS lhs env = case lhs of
+  LeftHandSideWildcard tp -> (LHSLivenessWildcard tp, env)
+  LeftHandSideSingle tp
+    | (m, env') <- lEnvStrengthen env
+    -> (LHSLivenessSingle m tp, env')
+  LeftHandSidePair lhs1 lhs2
+    | (lhs2', env')  <- lEnvStrengthenLHS lhs2 env
+    , (lhs1', env'') <- lEnvStrengthenLHS lhs1 env'
+    -> (LHSLivenessPair lhs1' lhs2', env'')
+
+lEnvStrengthenLHSReturn :: LeftHandSide s t env1 env2 -> LivenessEnv env2 -> (LHSLiveness s t env1 env2, LivenessEnv env1, ReturnImplications env1 t)
+lEnvStrengthenLHSReturn lhs env = case lhs of
+  LeftHandSideWildcard tp -> (LHSLivenessWildcard tp, env, mapTupR (const returnImplicationDead) tp)
+  LeftHandSideSingle tp
+    | (m, env') <- lEnvStrengthen env
+    -> (LHSLivenessSingle m tp, env', TupRsingle $ maybe ReturnLive ReturnImpliedBy m)
+  LeftHandSidePair lhs1 lhs2
+    | (lhs2', env',  r2) <- lEnvStrengthenLHSReturn lhs2 env
+    , (lhs1', env'', r1) <- lEnvStrengthenLHSReturn lhs1 env'
+    -> (LHSLivenessPair lhs1' lhs2', env'', TupRpair r1 (mapTupR (returnImplicationStrengthenByLHS lhs1') r2))
+
+-- ANALYSIS for languages with a return value
+
+data ReturnImplication env t
+  -- If any of the variables in the set is live,
+  -- then the returned value is live.
+  = ReturnImpliedBy (IdxSet env)
+  -- This return value is always live
+  | ReturnLive
 type ReturnImplications env = TupR (ReturnImplication env)
 
-noReturnImplications :: ReturnImplications env t
-noReturnImplications = TupRsingle $ ReturnImplication IdxSet.empty
+returnImplicationsLive :: ReturnImplications env t
+returnImplicationsLive = TupRsingle ReturnLive
 
-joinReturnImplication :: ReturnImplication env t -> ReturnImplication env t -> ReturnImplication env t
-joinReturnImplication (ReturnImplication a) (ReturnImplication b) = ReturnImplication $ IdxSet.union a b
+flattenReturnImplications :: ReturnImplications env t -> ReturnImplication env t
+flattenReturnImplications TupRunit = returnImplicationDead
+flattenReturnImplications (TupRsingle ret) = ret
+flattenReturnImplications (TupRpair r1 r2) = case (flattenReturnImplications r1, flattenReturnImplications r2) of
+  (ReturnLive, _) -> ReturnLive
+  (_, ReturnLive) -> ReturnLive
+  (ReturnImpliedBy a, ReturnImpliedBy b) -> ReturnImpliedBy $ IdxSet.union a b
 
-joinReturnImplications :: ReturnImplications env t -> ReturnImplications env t -> ReturnImplications env t
-joinReturnImplications (TupRsingle (ReturnImplication left))   right = mapTupR (joinReturnImplication $ ReturnImplication left) right
-joinReturnImplications left   (TupRsingle (ReturnImplication right)) = mapTupR (joinReturnImplication $ ReturnImplication right) left
-joinReturnImplications (TupRpair l1 l2)       (TupRpair r1 r2)       = joinReturnImplications l1 r1 `TupRpair` joinReturnImplications l2 r2
-joinReturnImplications TupRunit               TupRunit               = TupRunit
+returnImplicationDead :: ReturnImplication env t
+returnImplicationDead = ReturnImpliedBy IdxSet.empty
+
+returnImplicationStrengthenByLHS :: LHSLiveness s t env1 env2 -> ReturnImplication env2 u -> ReturnImplication env1 u
+returnImplicationStrengthenByLHS _ ReturnLive = ReturnLive
+returnImplicationStrengthenByLHS lhs' (ReturnImpliedBy impliedBy1) = go lhs' impliedBy1
+  where
+    go :: LHSLiveness s' t' env1 env2 -> IdxSet env2 -> ReturnImplication env1 t
+    go (LHSLivenessSingle m _) impliedBy
+      | ZeroIdx `IdxSet.member` impliedBy =
+        case m of 
+          Nothing -> ReturnLive
+          Just impliedBy' -> ReturnImpliedBy $ IdxSet.drop impliedBy `IdxSet.union` impliedBy'
+      | otherwise = ReturnImpliedBy $ IdxSet.drop impliedBy
+    go (LHSLivenessWildcard _) impliedBy = ReturnImpliedBy impliedBy
+    go (LHSLivenessPair lhs1 lhs2) impliedBy = case go lhs2 impliedBy of
+      ReturnLive -> ReturnLive
+      ReturnImpliedBy i -> go lhs1 i
+
+returnImplicationWeakenByLHS :: LeftHandSide s t env1 env2 -> ReturnImplication env1 u -> ReturnImplication env2 u
+returnImplicationWeakenByLHS _ ReturnLive = ReturnLive
+returnImplicationWeakenByLHS l (ReturnImpliedBy impliedBy) = ReturnImpliedBy $ IdxSet.skip' l impliedBy
+
+returnImplicationsWeakenByLHS :: LeftHandSide s t env1 env2 -> ReturnImplications env1 u -> ReturnImplications env2 u
+returnImplicationsWeakenByLHS lhs = mapTupR (returnImplicationWeakenByLHS lhs)
+
+returnVars :: ReturnImplications env t -> Vars s env t -> LivenessEnv env -> LivenessEnv env
+returnVars (TupRsingle ReturnLive) vars = setVarsLive vars
+returnVars (TupRsingle (ReturnImpliedBy impliedBy)) vars = addLiveImplications impliedBy $ IdxSet.fromVars vars
+returnVars _ (TupRsingle _) = internalError "Pair or unit impossible"
+returnVars TupRunit TupRunit = id
+returnVars (TupRpair r1 r2) (TupRpair v1 v2) = returnVars r1 v1 . returnVars r2 v2
+
+returnIndices :: ReturnImplications env t -> IdxSet env -> LivenessEnv env -> LivenessEnv env
+returnIndices ret indices = case flattenReturnImplications ret of
+  ReturnLive -> setIdxSetLive indices
+  (ReturnImpliedBy impliedBy) -> addLiveImplications impliedBy indices
 
 data SubTupR t t' where
   SubTupRskip :: SubTupR t ()
@@ -494,10 +372,143 @@ subTupDistribute SubTupRskip = SubTupRskip
 subTupDistribute SubTupRkeep = SubTupRkeep
 subTupDistribute (SubTupRpair s1 s2) = subTupDistribute @s s1 `SubTupRpair` subTupDistribute @s s2
 
+-- TRANSFORMATION
+
+data ReEnv env subenv where
+  ReEnvEnd  :: ReEnv () ()
+  ReEnvSkip :: ReEnv env subenv -> ReEnv (env, t) subenv
+  ReEnvKeep :: ReEnv env subenv -> ReEnv (env, t) (subenv, t)
+
+reEnvIdx :: ReEnv env subenv -> env :?> subenv
+reEnvIdx (ReEnvKeep _) ZeroIdx      = Just ZeroIdx
+reEnvIdx (ReEnvKeep r) (SuccIdx ix) = SuccIdx <$> reEnvIdx r ix
+reEnvIdx (ReEnvSkip r) (SuccIdx ix) = reEnvIdx r ix
+reEnvIdx _             _            = Nothing
+
+reEnvIndices :: ReEnv env subenv -> [Exists (Idx env)] -> [Exists (Idx subenv)]
+reEnvIndices re = mapMaybe $ \(Exists idx) -> Exists <$> reEnvIdx re idx
+
+reEnvIndices' :: ReEnv env subenv -> [Idx env t] -> [Idx subenv t]
+reEnvIndices' re = mapMaybe $ reEnvIdx re
+
+reEnvVar :: ReEnv env subenv -> Var s env t -> Maybe (Var s subenv t)
+reEnvVar re (Var tp idx) = Var tp <$> reEnvIdx re idx
+
+reEnvVars :: ReEnv env subenv -> Vars s env t -> Maybe (Vars s subenv t)
+reEnvVars re = traverseTupR $ reEnvVar re
+
+-- Fuse with lEnvStrengthenLHS (to be implemented) or let lEnvStrengthenLHS return its intermediate values in some data structure
+-- Is that data structure just something like (TupR Liveness), but then with some fixes for proper environment?
+bind :: LHSLiveness s t env env' -> ReEnv env subenv -> BindLiveness s t env' subenv
+bind lhs re = case lhs of
+  LHSLivenessSingle mImplied tp
+    -- Was this variable already known to be live (mImplied == Nothing),
+    -- or is one of the implied-by variables live (mImplied == Just implied && check re implied)?
+    | maybe True (isImpliedLive re) mImplied ->
+      BindLiveness (LeftHandSideSingle tp) $ ReEnvKeep re
+    | otherwise ->
+      BindLiveness (LeftHandSideWildcard $ TupRsingle tp) $ ReEnvSkip re
+  LHSLivenessWildcard tp ->
+    BindLiveness (LeftHandSideWildcard tp) re
+  LHSLivenessPair lhs1 lhs2
+    | BindLiveness lhs1' re1 <- bind lhs1 re
+    , BindLiveness lhs2' re2 <- bind lhs2 re1
+    -> BindLiveness (leftHandSidePair lhs1' lhs2') re2
+
+-- Given an implied-by set, checks if the variabble is live according to the ReEnv.
+-- That is, it checks if one of the indices in the IdxSet is live in ReEnv.
+isImpliedLive :: ReEnv env1 subenv1 -> IdxSet env1 -> Bool
+isImpliedLive _ (IdxSet PEnd) = False
+isImpliedLive (ReEnvKeep env) impliedBy
+  | ZeroIdx `IdxSet.member` impliedBy = True -- One of the members of impliedBy is live
+  | otherwise = isImpliedLive env $ IdxSet.drop impliedBy
+isImpliedLive (ReEnvSkip env) impliedBy = isImpliedLive env $ IdxSet.drop impliedBy
+
+-- Captures the existentional subenv'
+data BindLiveness s t env' subenv where
+  BindLiveness
+    :: LeftHandSide s t subenv subenv'
+    -> ReEnv env' subenv'
+    -> BindLiveness s t env' subenv
+
+bindSub :: LHSLiveness s t env env' -> ReEnv env subenv -> BindLivenessSub s t env' subenv
+bindSub lhs re = case lhs of
+  LHSLivenessSingle mImplied tp
+    -- Was this variable already known to be live (mImplied == Nothing),
+    -- or is one of the implied-by variables live (mImplied == Just implied && check re implied)?
+    | maybe True (isImpliedLive re) mImplied ->
+      BindLivenessSub
+        SubTupRkeep
+        (LeftHandSideSingle tp)
+        (LeftHandSideSingle tp)
+        (ReEnvKeep re)
+    | otherwise ->
+      BindLivenessSub
+        SubTupRskip
+        (LeftHandSideWildcard $ TupRsingle tp)
+        (LeftHandSideWildcard TupRunit)
+        (ReEnvSkip re)
+  LHSLivenessWildcard tp ->
+    BindLivenessSub
+      SubTupRskip
+      (LeftHandSideWildcard tp)
+      (LeftHandSideWildcard TupRunit)
+      re
+  LHSLivenessPair lhs1 lhs2
+    | BindLivenessSub subTup1 lhs1Full lhs1Sub re1 <- bindSub lhs1 re
+    , BindLivenessSub subTup2 lhs2Full lhs2Sub re2 <- bindSub lhs2 re1
+    -> if
+        | LeftHandSideWildcard _ <- lhs1Sub
+        , LeftHandSideWildcard _ <- lhs2Sub ->
+          BindLivenessSub
+            SubTupRskip
+            (leftHandSidePair lhs1Full lhs2Full)
+            (LeftHandSideWildcard TupRunit)
+            re2
+
+        | SubTupRkeep <- subTup1
+        , SubTupRkeep <- subTup2
+        , lhs' <- leftHandSidePair lhs1Full lhs2Full ->
+          BindLivenessSub
+            SubTupRkeep
+            lhs'
+            lhs'
+            re2
+
+        | otherwise ->
+          BindLivenessSub
+            (SubTupRpair subTup1 subTup2)
+            (leftHandSidePair lhs1Full lhs2Full)
+            (leftHandSidePair lhs1Sub lhs2Sub)
+            re2
+
+-- Captures the existentionals subenv' and t'
+data BindLivenessSub s t env' subenv where
+  BindLivenessSub
+    :: SubTupR t t'
+    -> LeftHandSide s t  subenv subenv'
+    -> LeftHandSide s t' subenv subenv'
+    -> ReEnv env' subenv'
+    -> BindLivenessSub s t env' subenv
+
+-- For an IR parameterized over the result type, implement a function of this
+-- type:
+--
+-- stronglyLiveVariables :: LivenessEnv env -> ReturnImplications env t -> SomeAcc env t -> LVAnalysis SomeAcc env t
+--
+-- If the IR does have a result type, but we cannot change that type, then use:
+--
+-- stronglyLiveVariables :: LivenessEnv env -> ReturnImplications env t -> SomeAcc env t -> LVAnalysisFun SomeAcc env t
+--
+-- For an IR which is not parameterized over the result type, but only over the
+-- environment, implement a function of this type:
+--
+-- stronglyLiveVariables :: LivenessEnv env -> SomeAcc env -> LVAnalysis' SomeAcc env
+
+-- If this part of the returned value is returned, then this set of variables is live
 data LVAnalysis ir env t where
   LVAnalysis
     :: LivenessEnv env
-    -> ReturnImplications env t
     -- Depending on the binding, it may or may not be possible to restrict the
     -- term to only the used parts of the tuple.
     -> (forall subenv t'. ReEnv env subenv -> SubTupR t t' -> Either (ir subenv t) (ir subenv t'))
@@ -539,3 +550,62 @@ subTupDBuf SubTupRskip         _                = TupRunit
 subTupDBuf SubTupRkeep         t                = t
 subTupDBuf (SubTupRpair s1 s2) (TupRpair t1 t2) = subTupDBuf s1 t1 `TupRpair` subTupDBuf s2 t2
 subTupDBuf _                   _                = internalError "Tuple mismatch"
+
+data DeclareSubVars s t t' env where
+  DeclareSubVars :: LeftHandSide s t env env'
+                 -> (env :> env')
+                 -> (forall env''. env' :> env'' -> Vars s env'' t')
+                 -> DeclareSubVars s t t' env
+
+declareSubVars :: TupR s t -> SubTupR t t' -> DeclareSubVars s t t' env
+declareSubVars tp SubTupRkeep
+  | DeclareVars lhs k vars <- declareVars tp = DeclareSubVars lhs k vars
+declareSubVars tp SubTupRskip
+  = DeclareSubVars (LeftHandSideWildcard tp) weakenId (const TupRunit)
+declareSubVars (TupRpair t1 t2) (SubTupRpair s1 s2)
+  | DeclareSubVars lhs1 subst1 a1 <- declareSubVars t1 s1
+  , DeclareSubVars lhs2 subst2 a2 <- declareSubVars t2 s2
+  = DeclareSubVars (LeftHandSidePair lhs1 lhs2) (subst2 .> subst1) $ \k -> a1 (k .> subst2) `TupRpair` a2 k
+declareSubVars _ _ = internalError "Tuple mismatch"
+
+data DeclareMissingVars s t t' env where
+  -- Captures existentials env' and t''.
+  DeclareMissingVars :: LeftHandSide s t'' env env'
+                     -> (env :> env')
+                     -> (forall env''. env' :> env'' -> Vars s env'' t)
+                     -> DeclareMissingVars s t t' env
+
+declareMissingVars :: TupR s t -> SubTupR t t' -> Vars s env t' -> DeclareMissingVars s t t' env
+declareMissingVars _  SubTupRkeep vars = DeclareMissingVars (LeftHandSideWildcard TupRunit) weakenId (\k -> mapTupR (weaken k) vars)
+declareMissingVars tp SubTupRskip _
+  | DeclareVars lhs k value <- declareVars tp
+  = DeclareMissingVars lhs k value
+declareMissingVars (TupRpair t1 t2) (SubTupRpair s1 s2) (TupRpair v1 v2)
+  | DeclareMissingVars lhs1 subst1 value1 <- declareMissingVars t1 s1 v1
+  , DeclareMissingVars lhs2 subst2 value2 <- declareMissingVars t2 s2 (mapTupR (weaken subst1) v2)
+  = DeclareMissingVars (LeftHandSidePair lhs1 lhs2) (subst2 .> subst1) $ \k -> value1 (k .> subst2) `TupRpair` value2 k
+declareMissingVars _ _ _ = internalError "Tuple mismatch"
+
+data DeclareMissingDistributedVars f s' s t t' env where
+  -- Captures existentials env' and t''.
+  DeclareMissingDistributedVars
+    :: TupR s' t''
+    -> LeftHandSide s (Distribute f t'') env env'
+    -> (env :> env')
+    -> (forall env''. env' :> env'' -> Vars s env'' (Distribute f t))
+    -> DeclareMissingDistributedVars f s' s t t' env
+
+-- 'f' is ambiguous
+declareMissingDistributedVars
+  :: forall f s' s t t' env.
+     TupR s' t -> TupR s (Distribute f t) -> SubTupR t t' -> Vars s env (Distribute f t') -> DeclareMissingDistributedVars f s' s t t' env
+declareMissingDistributedVars _ _ SubTupRkeep vars
+  = DeclareMissingDistributedVars TupRunit (LeftHandSideWildcard TupRunit) weakenId (\k -> mapTupR (weaken k) vars)
+declareMissingDistributedVars tp tp' SubTupRskip _
+  | DeclareVars lhs k value <- declareVars tp'
+  = DeclareMissingDistributedVars tp lhs k value
+declareMissingDistributedVars (TupRpair t1 t2) (TupRpair t1' t2') (SubTupRpair s1 s2) (TupRpair v1 v2)
+  | DeclareMissingDistributedVars st1 lhs1 subst1 value1 <- declareMissingDistributedVars @f t1 t1' s1 v1
+  , DeclareMissingDistributedVars st2 lhs2 subst2 value2 <- declareMissingDistributedVars @f t2 t2' s2 (mapTupR (weaken subst1) v2)
+  = DeclareMissingDistributedVars (TupRpair st1 st2) (LeftHandSidePair lhs1 lhs2) (subst2 .> subst1) $ \k -> value1 (k .> subst2) `TupRpair` value2 k
+declareMissingDistributedVars _ _ _ _ = internalError "Tuple mismatch"
diff --git a/src/Data/Array/Accelerate/Trafo/Operation/LiveVars.hs b/src/Data/Array/Accelerate/Trafo/Operation/LiveVars.hs
index ebc1fa74e..bc4e55b88 100644
--- a/src/Data/Array/Accelerate/Trafo/Operation/LiveVars.hs
+++ b/src/Data/Array/Accelerate/Trafo/Operation/LiveVars.hs
@@ -50,11 +50,6 @@ import Data.List ( foldl' )
 import Data.Maybe
 import Data.Type.Equality
 
---TODO remove
--- stronglyLiveVariables, stronglyLiveVariablesFun :: a -> a
--- stronglyLiveVariables = id
--- stronglyLiveVariablesFun = id
-
 stronglyLiveVariablesFun :: SLVOperation op => PreOpenAfun op () t -> PreOpenAfun op () t
 stronglyLiveVariablesFun acc = acc' ReEnvEnd
   where
@@ -63,53 +58,50 @@ stronglyLiveVariablesFun acc = acc' ReEnvEnd
 stronglyLiveVariables :: SLVOperation op => PreOpenAcc op () t -> PreOpenAcc op () t
 stronglyLiveVariables acc = fromEither' $ acc' ReEnvEnd SubTupRkeep
   where
-    LVAnalysis _ _ acc' = stronglyLiveVariables' emptyLivenessEnv (mapTupR (const Shared) $ groundsR acc) acc
+    LVAnalysis _ acc' = stronglyLiveVariables' emptyLivenessEnv returnImplicationsLive (mapTupR (const Shared) $ groundsR acc) acc
 
 stronglyLiveVariablesFun' :: SLVOperation op => LivenessEnv env -> PreOpenAfun op env t -> LVAnalysisFun (PreOpenAfun op) env t
 stronglyLiveVariablesFun' liveness (Alam lhs f)
-  | liveness1 <- pushLivenessEnv lhs noReturnImplications liveness
+  | liveness1 <- lEnvPushLHS lhs liveness
   , LVAnalysisFun liveness2 f' <- stronglyLiveVariablesFun' liveness1 f
-  , liveness3 <- dropLivenessEnv lhs liveness2
+  , (lhs', liveness3) <- lEnvStrengthenLHS lhs liveness2
   = LVAnalysisFun
       liveness3
       $ \re -> if
-        | BindLiveness lhs' re' <- bind lhs re liveness2 ->
-          Alam lhs' $ f' re'
+        | BindLiveness lhs'' re' <- bind lhs' re ->
+          Alam lhs'' $ f' re'
 stronglyLiveVariablesFun' liveness (Abody body)
-  | LVAnalysis liveness1 returnImplications body' <- stronglyLiveVariables' liveness (mapTupR (const Shared) $ groundsR body) body
-  , liveness2 <- foldl' (\e (Exists (ReturnImplication set)) -> setIndicesLive (IdxSet.toList set) e) liveness1 $ flattenTupR returnImplications
+  | LVAnalysis liveness1 body' <- stronglyLiveVariables' liveness returnImplicationsLive (mapTupR (const Shared) $ groundsR body) body
   = LVAnalysisFun
-      liveness2
+      liveness1
       $ \re -> Abody $ fromEither' $ body' re SubTupRkeep
 
 stronglyLiveVariablesFun'' :: SLVOperation op => LivenessEnv env -> Uniquenesses t -> PreOpenAfun op env (s -> t) -> LVAnalysisFun (PreOpenAfun op) env (s -> t)
 stronglyLiveVariablesFun'' liveness us (Alam lhs (Abody body))
-  | liveness1 <- pushLivenessEnv lhs noReturnImplications liveness
-  , LVAnalysis liveness2 returnImplications body' <- stronglyLiveVariables' liveness1 us body
-  , liveness3 <- foldl' (\e (Exists (ReturnImplication indices)) -> setIndicesLive (IdxSet.toList indices) e) liveness2 $ flattenTupR returnImplications
-  , liveness4 <- dropLivenessEnv lhs liveness3
+  | liveness1 <- lEnvPushLHS lhs liveness
+  , LVAnalysis liveness2 body' <- stronglyLiveVariables' liveness1 returnImplicationsLive us body
+  , (lhs', liveness3) <- lEnvStrengthenLHS lhs liveness2
   = LVAnalysisFun
-      liveness4
+      liveness3
       $ \re -> if
-        | BindLiveness lhs' re' <- bind lhs re liveness3 ->
-          Alam lhs' $ Abody $ fromEither' $ body' re' SubTupRkeep
+        | BindLiveness lhs'' re' <- bind lhs' re ->
+          Alam lhs'' $ Abody $ fromEither' $ body' re' SubTupRkeep
 stronglyLiveVariablesFun'' _ _ _ = internalError "Function impossible"
 
 fromEither' :: Either a a -> a
 fromEither' (Left  x) = x
 fromEither' (Right x) = x
 
-stronglyLiveVariables' :: SLVOperation op => LivenessEnv env -> Uniquenesses t -> PreOpenAcc op env t -> LVAnalysis (PreOpenAcc op) env t
-stronglyLiveVariables' liveness us = \case
+stronglyLiveVariables' :: SLVOperation op => LivenessEnv env -> ReturnImplications env t -> Uniquenesses t -> PreOpenAcc op env t -> LVAnalysis (PreOpenAcc op) env t
+stronglyLiveVariables' liveness returns us = \case
   Exec op args
     | Just (ShrinkOperation shrinkOp) <- slvOperation op
     -- We can shrink this operation to output to part of its buffers.
     , input <- IdxSet.fromList $ inputs args
     , output <- IdxSet.fromList $ outputs args
-    , liveness1 <- setLivenessImplications output input liveness ->
+    , liveness1 <- addLiveImplications output input liveness ->
       LVAnalysis
         liveness1
-        noReturnImplications
         $ \re s -> if
           | Refl <- subTupUnit s
           , allDead re output ->
@@ -125,10 +117,9 @@ stronglyLiveVariables' liveness us = \case
     -- buffers, then the entire operation is live.
     | free <- IdxSet.fromList $ map (\(Exists (Var _ idx)) -> Exists idx) $ argsVars args
     , output <- IdxSet.fromList $ outputs args
-    , liveness1 <- setLivenessImplications output free liveness ->
+    , liveness1 <- addLiveImplications output free liveness ->
       LVAnalysis
         liveness1
-        noReturnImplications
         $ \re s -> if
           | Refl <- subTupUnit s
           , allDead re output ->
@@ -137,24 +128,18 @@ stronglyLiveVariables' liveness us = \case
           | Refl <- subTupUnit s
           , args' <- reEnvArgs re args ->
             Right $ Exec op args' -- Live
-
-  Return vars ->
-    let
-      returnImplications = mapTupR (\(Var _ idx) -> ReturnImplication $ IdxSet.singleton idx) vars
-    in
+  Return vars
+    | liveness1 <- returnVars returns vars liveness ->
       LVAnalysis
-        liveness
-        returnImplications
+        liveness1
         $ \re s -> Right $ Return $ expectJust $ reEnvVars re $ subTupR s vars
-  Compute expr ->
-    let
-      -- If the LHS of the binding is live, then all free variables of this
-      -- expression are live as well.
-      free = expGroundVars expr
-    in
+  Compute expr
+    -- If the LHS of the binding is live, then all free variables of this
+    -- expression are live as well.
+    | free <- expGroundVars expr
+    , liveness1 <- returnIndices returns (IdxSet.fromVarList free) liveness ->
       LVAnalysis
-        liveness
-        (TupRsingle $ ReturnImplication $ IdxSet.fromVarList free)
+        liveness1
         $ \re s ->
           let
             tp = expType expr
@@ -165,26 +150,23 @@ stronglyLiveVariables' liveness us = \case
               _ | DeclareSubVars lhs _ vars <- declareSubVars tp s
                 -> Right $ Compute $ Let lhs expr' $ returnExpVars $ vars weakenId
   Alet lhs us' bnd body
-    | LVAnalysis liveness1 retBnd bnd' <- stronglyLiveVariables' liveness  us' bnd
-    , liveness2 <- pushLivenessEnv lhs retBnd liveness1
-    , LVAnalysis liveness3 ret   body' <- stronglyLiveVariables' liveness2 us body
-    , droppedRetBnd <- mapTupR (droppedReturnImplications lhs) ret ->
+    | liveness1 <- lEnvPushLHS lhs liveness
+    , LVAnalysis liveness2 body' <- stronglyLiveVariables' liveness1 (returnImplicationsWeakenByLHS lhs returns) us body
+    , (lhs', liveness3, returns') <- lEnvStrengthenLHSReturn lhs liveness2
+    , LVAnalysis liveness4 bnd' <- stronglyLiveVariables' liveness3 returns' us' bnd ->
       LVAnalysis
-        (dropLivenessEnv lhs liveness3)
-        (mapTupR (strengthenReturnImplications liveness3 $ strengthenWithLHS lhs) ret)
-        $ \re s -> case bindSub lhs re $ propagateReturnLiveness s droppedRetBnd liveness3 of
+        liveness4
+        $ \re s -> case bindSub lhs' re of
           BindLivenessSub subTup' lhsFull lhsSub re' -> case (bnd' re subTup', body' re' s) of
             (Left bnd'',  Left body'')  -> Left  $ mkAlet lhsFull us' bnd'' body''
             (Left bnd'',  Right body'') -> Right $ mkAlet lhsFull us' bnd'' body''
             (Right bnd'', Left body'')  -> Left  $ mkAlet lhsSub (subTupR subTup' us') bnd'' body''
             (Right bnd'', Right body'') -> Right $ mkAlet lhsSub (subTupR subTup' us') bnd'' body''
-  Alloc shr tp sh ->
-    let
-      free = IdxSet.fromVars sh
-    in
+  Alloc shr tp sh
+    | free <- IdxSet.fromVars sh
+    , liveness1 <- returnIndices returns free liveness ->
       LVAnalysis
-        liveness
-        (TupRsingle $ ReturnImplication free)
+        liveness1
         $ \re s ->
           case s of
             SubTupRskip -> Right $ Return TupRunit
@@ -192,29 +174,25 @@ stronglyLiveVariables' liveness us = \case
   Use tp size buffer ->
     LVAnalysis
       liveness
-      noReturnImplications
       $ \_ s ->
         case s of
           SubTupRskip -> Right $ Return TupRunit
           SubTupRkeep -> Right $ Use tp size buffer
-  Unit var ->
-    let
-      free = IdxSet.singleton $ varIdx var
-    in
+  Unit var
+    | free <- IdxSet.singleton $ varIdx var
+    , liveness1 <- returnIndices returns free liveness ->
       LVAnalysis
-        liveness
-        (TupRsingle $ ReturnImplication free)
+        liveness1
         $ \re s ->
           case s of
             SubTupRskip -> Right $ Return TupRunit
             SubTupRkeep -> Right $ Unit $ expectJust $ reEnvVar re var
   Acond condition true false
     | liveness1 <- setLive (varIdx condition) liveness
-    , LVAnalysis liveness2 retTrue  true'  <- stronglyLiveVariables' liveness1 us true
-    , LVAnalysis liveness3 retFalse false' <- stronglyLiveVariables' liveness2 us false ->
+    , LVAnalysis liveness2 true'  <- stronglyLiveVariables' liveness1 returns us true
+    , LVAnalysis liveness3 false' <- stronglyLiveVariables' liveness2 returns us false ->
       LVAnalysis
         liveness3
-        (joinReturnImplications retTrue retFalse)
         $ \re s ->
           let condition' = expectJust $ reEnvVar re condition
           in case (true' re s, false' re s) of
@@ -234,7 +212,6 @@ stronglyLiveVariables' liveness us = \case
     , LVAnalysisFun liveness3 step'      <- stronglyLiveVariablesFun'' liveness2 us' step ->
       LVAnalysis
         liveness3
-        noReturnImplications
         $ \re _ ->
           Left $ Awhile us' (condition' re) (step' re) $ expectJust $ reEnvVars re initial
   where
diff --git a/src/Data/Array/Accelerate/Trafo/Schedule/Uniform/LiveVars.hs b/src/Data/Array/Accelerate/Trafo/Schedule/Uniform/LiveVars.hs
index a3e6f4b40..78930f159 100644
--- a/src/Data/Array/Accelerate/Trafo/Schedule/Uniform/LiveVars.hs
+++ b/src/Data/Array/Accelerate/Trafo/Schedule/Uniform/LiveVars.hs
@@ -56,34 +56,39 @@ stronglyLiveVariablesFun' liveness = \case
     | LVAnalysis' liveness2 body' <- stronglyLiveVariables' liveness body
       -> LVAnalysisFun liveness2 $ \re -> Sbody $ body' re
   Slam lhs f
-    | liveness1 <-
-      setIndicesLive
-        (mapMaybe (\(Exists (Var tp idx)) -> if isOutput tp then Just $ Exists idx else Nothing) $ lhsVars lhs)
-        (pushLivenessEnv lhs noReturnImplications liveness)
-    , LVAnalysisFun liveness2 f' <- stronglyLiveVariablesFun' liveness1 f
+    | liveness1 <- lEnvPushLHS lhs liveness
+    , liveness2 <-
+      setIdxSetLive
+        (IdxSet.fromList
+          $ mapMaybe (\(Exists (Var tp idx)) -> if isOutput tp then Just $ Exists idx else Nothing)
+          $ lhsVars lhs)
+        liveness1
+    , LVAnalysisFun liveness3 f' <- stronglyLiveVariablesFun' liveness2 f
+    , (lhs', liveness4) <- lEnvStrengthenLHS lhs liveness3
       -> LVAnalysisFun
-          (dropLivenessEnv lhs liveness2)
+          liveness4
           $ \re -> if -- A one-way "multi way if" to pattern match on a GADT
-            | BindLiveness lhs' re' <- bind lhs re liveness2
-              -> Slam lhs' $ f' re'
+            | BindLiveness lhs'' re' <- bind lhs' re
+              -> Slam lhs'' $ f' re'
 
 stronglyLiveVariables' :: LivenessEnv env -> UniformSchedule kernel env -> LVAnalysis' (UniformSchedule kernel) env
 stronglyLiveVariables' liveness = \case
   Return -> LVAnalysis' liveness $ const Return
   Alet lhs binding body ->
     let
-      liveness1 = analyseBinding (weakenWithLHS lhs) (lhsIndices lhs) binding $ pushLivenessEnv lhs noReturnImplications liveness
+      liveness1 = analyseBinding (weakenWithLHS lhs) (lhsIndices lhs) binding $ lEnvPushLHS lhs liveness
       LVAnalysis' liveness2 body' = stronglyLiveVariables' liveness1 body
+      (lhs', liveness3) = lEnvStrengthenLHS lhs liveness2
     in
       LVAnalysis'
-        (dropLivenessEnv lhs liveness2)
+        liveness3
         $ \re -> if -- A one-way "multi way if" to pattern match on a GADT
-          | BindLiveness lhs' re' <- bind lhs re liveness2 -> case lhs' of
+          | BindLiveness lhs'' re' <- bind lhs' re -> case lhs'' of
             LeftHandSideWildcard _ -> body' re' -- Entire binding wasn't used
-            _ -> Alet lhs' (reEnvBinding re binding) (body' re')
+            _ -> Alet lhs'' (reEnvBinding re binding) (body' re')
   Effect (SignalAwait signals) (Effect (SignalResolve resolvers) Return) ->
     let
-      liveness1 = setLivenessImplications (IdxSet.fromList $ map Exists resolvers) (IdxSet.fromList $ map Exists signals) liveness
+      liveness1 = addLiveImplications (IdxSet.fromList $ map Exists resolvers) (IdxSet.fromList $ map Exists signals) liveness
     in
       LVAnalysis'
         liveness1
@@ -142,31 +147,31 @@ analyseBinding k lhs binding liveness = case binding of
       -- expression are live as well.
       free = map (\(Exists (Var _ idx)) -> Exists $ k >:> idx) $ expGroundVars expr
     in
-      setLivenessImplications lhs (IdxSet.fromList free) liveness
+      addLiveImplications lhs (IdxSet.fromList free) liveness
   NewSignal
     | IdxSet (_ `PPush` _ `PPush` _) <- lhs ->
       -- If the signal is live, then the resolver is live as well.
-      setLivenessImplies
-        (SuccIdx ZeroIdx) 
-        (IdxSet.singleton ZeroIdx)
+      addLiveImplies
+        (SuccIdx ZeroIdx)
+        (ZeroIdx)
         liveness
     | otherwise -> liveness
   NewRef _
     | IdxSet (_ `PPush` _ `PPush` _) <- lhs ->
       -- If the Ref is live, then the OutputRef is live as well.
-      setLivenessImplies
-        (SuccIdx ZeroIdx) 
-        (IdxSet.singleton ZeroIdx)
+      addLiveImplies
+        (SuccIdx ZeroIdx)
+        (ZeroIdx)
         liveness
     | otherwise -> liveness
   Alloc _ _ sh ->
     -- If this buffer is live, then the shape variables are live as well.
-    setLivenessImplications lhs (IdxSet.fromVars $ mapTupR (weaken k) sh) liveness
+    addLiveImplications lhs (IdxSet.fromVars $ mapTupR (weaken k) sh) liveness
   Use _ _ _ -> liveness
   Unit (Var _ idx) -> -- If the lhs is live, then the argument of Unit is live as well.
-    setLivenessImplications lhs (IdxSet.singleton $ k >:> idx) liveness
+    addLiveImplications lhs (IdxSet.singleton $ k >:> idx) liveness
   RefRead (Var _ idx) -> -- If the lhs is live, then the Ref is live as well.
-    setLivenessImplications lhs (IdxSet.singleton $ k >:> idx) liveness
+    addLiveImplications lhs (IdxSet.singleton $ k >:> idx) liveness
 
 reEnvBinding :: ReEnv env subenv -> Binding env t -> Binding subenv t
 reEnvBinding re = \case
@@ -179,10 +184,10 @@ reEnvBinding re = \case
   RefRead var      -> RefRead $ expectJust $ reEnvVar re var
 
 analyseEffect :: Effect kernel env -> LivenessEnv env -> LivenessEnv env
-analyseEffect (Exec _ _ args) liveness = setIndicesLive (argsIndices args) liveness
-analyseEffect (SignalAwait signals) liveness = setIndicesLive (map Exists signals) liveness
+analyseEffect (Exec _ _ args) liveness = setIdxSetLive (IdxSet.fromList $ argsIndices args) liveness
+analyseEffect (SignalAwait signals) liveness = setIdxSetLive (IdxSet.fromList $ map Exists signals) liveness
 analyseEffect (SignalResolve _) liveness = liveness
-analyseEffect (RefWrite ref value) liveness = setLivenessImplies (varIdx ref) (IdxSet.singleton $ varIdx value) liveness
+analyseEffect (RefWrite ref value) liveness = addLiveImplies (varIdx ref) (varIdx value) liveness
 
 reEnvEffect :: ReEnv env subenv -> Effect kernel env -> UniformSchedule kernel subenv -> UniformSchedule kernel subenv
 reEnvEffect re = \case

From 53f0b6a04e5627a9e625ca620934a3a5008aa168 Mon Sep 17 00:00:00 2001
From: Ivo Gabe de Wolff <ivogabe@ivogabe.nl>
Date: Wed, 13 Sep 2023 12:09:49 +0200
Subject: [PATCH 61/62] Fix edge case in addLiveImplications `setIdxSetLive`
 could mark earlier entries live, indirectly. Hence it is not sound to skip
 over the outer layers of the environment.

---
 src/Data/Array/Accelerate/Trafo/LiveVars.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/Data/Array/Accelerate/Trafo/LiveVars.hs b/src/Data/Array/Accelerate/Trafo/LiveVars.hs
index a3fb3788a..646afaebc 100644
--- a/src/Data/Array/Accelerate/Trafo/LiveVars.hs
+++ b/src/Data/Array/Accelerate/Trafo/LiveVars.hs
@@ -130,13 +130,10 @@ addLiveImplies = \idx1 idx2 env -> fromMaybe (setLive idx2 env) $ go idx1 idx2 e
 
 -- If any of impliedBy becomes live, then implies are live.
 addLiveImplications :: IdxSet env -> IdxSet env -> LivenessEnv env -> LivenessEnv env
-addLiveImplications impliedBy implies (LPush env l)
-  | not (ZeroIdx `IdxSet.member` impliedBy || ZeroIdx `IdxSet.member` implies)
-  = LPush (addLiveImplications (IdxSet.drop impliedBy) (IdxSet.drop implies) env) l
 addLiveImplications impliedBy implies env
   | anyIsLive impliedBy env
   = setIdxSetLive implies env
-addLiveImplications impliedBy implies env
+  | otherwise
   = addLiveImplicationsCurrentlyUnknown impliedBy implies env
 
 -- If any of impliedBy becomes live, then implies are live.

From c67daa056bf127c82c48d9063029c83d05ffc86a Mon Sep 17 00:00:00 2001
From: Ivo Gabe de Wolff <ivogabe@ivogabe.nl>
Date: Thu, 21 Sep 2023 15:08:29 +0200
Subject: [PATCH 62/62] Fix issue with propagation of liveness A newly-live
 variable may be present in implied-by sets of other variables.

---
 src/Data/Array/Accelerate/Trafo/LiveVars.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/Data/Array/Accelerate/Trafo/LiveVars.hs b/src/Data/Array/Accelerate/Trafo/LiveVars.hs
index 646afaebc..409a2f1e6 100644
--- a/src/Data/Array/Accelerate/Trafo/LiveVars.hs
+++ b/src/Data/Array/Accelerate/Trafo/LiveVars.hs
@@ -166,7 +166,10 @@ setLive = \idx env -> uncurry setIdxSetLive $ go idx env
       Live -> (IdxSet.skip newSet, LPush env' Live)
       Unknown implies impliedBy
         | idx `IdxSet.member` impliedBy ->
-          (IdxSet.skip $ implies `IdxSet.union` newSet, LPush env' Live)
+          -- This variable may be present in the implied-by set of other variables,
+          -- hence we need to add it to the IdxSet and potentially mark other variables
+          -- live in the next iteration of setIdxSetLive.
+          (IdxSet.push $ implies `IdxSet.union` newSet, LPush env' Live)
         | otherwise ->
           (IdxSet.skip $ newSet, LPush env' $ Unknown (IdxSet.remove idx implies) impliedBy)
       where
@@ -186,7 +189,10 @@ setIdxSetLive = \set env ->
       Unknown implies impliedBy
         -- Does this variable become live?
         | ZeroIdx `IdxSet.member` liveSet || IdxSet.overlaps tailLiveSet impliedBy ->
-          (IdxSet.skip $ implies `IdxSet.union` newSet, LPush env' Live)
+          -- This variable may be present in the implied-by set of other variables,
+          -- hence we need to add it to the IdxSet and potentially mark other variables
+          -- live in the next iteration of setIdxSetLive.
+          (IdxSet.push $ implies `IdxSet.union` newSet, LPush env' Live)
         | otherwise ->
           (IdxSet.skip newSet, LPush env' $ Unknown (implies IdxSet.\\ tailLiveSet) impliedBy)
       where
@@ -204,7 +210,7 @@ isLive ZeroIdx       (LPush _   l) = case l of
 
 anyIsLive :: IdxSet env -> LivenessEnv env -> Bool
 anyIsLive (IdxSet PEnd) _ = False
-anyIsLive indices (LPush env Live)
+anyIsLive indices (LPush _ Live)
   | ZeroIdx `IdxSet.member` indices = True
 anyIsLive indices (LPush env _) = anyIsLive (IdxSet.drop indices) env