{-# LANGUAGE MagicHash, UnboxedTuples, UnliftedDatatypes #-}
{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -dno-suppress-type-signatures -dno-typeable-binds #-}
-- O2 is necessary to get the right call pattern specializations and remove all the lifted abstractions
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}

{-|
Module      : Fleet.Array
Description : Fleet arrays
Copyright   : (c) Jaro Reinders, 2025
License     : BSD-3-Clause
Maintainer  : jaro.reinders@gmail.com
Stability   : experimental
Portability : Portable

This module defines fleet arrays and their basic interface.

All the asymptotic complexities listed in this module assume you are modifying
the latest version of the array. Otherwise the performance regresses to O(k),
where k is the number of changes between the version you are accessing and the
latest version.
-}
module Fleet.Array
  ( Array
  , fromList
  , replicate
  , toList
  , (!)
  , index
  , tag
  , set
  , copy
  , swap
  ) where

import Prelude hiding (replicate)

import GHC.Exts hiding (fromList, toList, Lifted)

import Data.Kind (Type)
import GHC.Base (IO (IO))
-- import GHC.IO.Unsafe (unsafeDupablePerformIO)

import Fleet.Array.MutVar
import Fleet.Array.Lift
import Fleet.Array.MutArray

unsafeDupablePerformIO :: IO a -> a
unsafeDupablePerformIO :: forall a. IO a -> a
unsafeDupablePerformIO (IO State# RealWorld -> (# State# RealWorld, a #)
f) = (State# RealWorld -> a) -> a
forall o. (State# RealWorld -> o) -> o
runRW# (\State# RealWorld
s -> case State# RealWorld -> (# State# RealWorld, a #)
f State# RealWorld
s of (# State# RealWorld
_ , a
x #) -> a
x)

data Op a = Set {-# UNPACK #-} !Int a | Swap {-# UNPACK #-} !Int {-# UNPACK #-} !Int

-- | Fleet arrays.
data Array a = A {-# UNPACK #-} !(ArrayVar a)
type ArrayData# :: Type -> UnliftedType
data ArrayData# a
  = Current# {-# UNPACK #-} !(MutArray a)
  | Diff# {-# UNPACK #-} !(Op a) {-# UNPACK #-} !(ArrayVar a)

type ArrayVar a = MutVar (ArrayData# a)

type ArrayData a = Lift (ArrayData# a)
pattern Current :: MutArray a -> ArrayData a
pattern $mCurrent :: forall {r} {a}.
ArrayData a -> (MutArray a -> r) -> ((# #) -> r) -> r
$bCurrent :: forall a. MutArray a -> ArrayData a
Current x = Lift (Current# x)
pattern Diff :: Op a -> ArrayVar a -> ArrayData a
pattern $mDiff :: forall {r} {a}.
ArrayData a -> (Op a -> ArrayVar a -> r) -> ((# #) -> r) -> r
$bDiff :: forall a. Op a -> ArrayVar a -> ArrayData a
Diff op v = Lift (Diff# op v)
{-# COMPLETE Current, Diff #-}

instance Show a => Show (Array a) where
  show :: Array a -> String
show Array a
xs = String
"fromList " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show (Array a -> [a]
forall a. Array a -> [a]
toList Array a
xs)

-- | Convert a list into an array. O(n)
fromList :: [a] -> Array a
fromList :: forall a. [a] -> Array a
fromList [a]
xs = IO (Array a) -> Array a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ do
  MutArray a
arr0 <- Int -> a -> IO (MutArray a)
forall a. Int -> a -> IO (MutArray a)
newMutArray ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
forall a. HasCallStack => a
undefined
  let go :: MutArray a -> Int -> [a] -> IO ()
go MutArray a
_ Int
_ [] = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      go MutArray a
arr Int
i (a
x:[a]
xs') = MutArray a -> Int -> a -> IO ()
forall a. MutArray a -> Int -> a -> IO ()
writeMutArray MutArray a
arr Int
i a
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MutArray a -> Int -> [a] -> IO ()
go MutArray a
arr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs'
  MutArray a -> Int -> [a] -> IO ()
forall {a}. MutArray a -> Int -> [a] -> IO ()
go MutArray a
arr0 Int
0 [a]
xs
  MutVar (ArrayData# a)
v <- Lift (ArrayData# a) -> IO (MutVar (ArrayData# a))
forall (a :: UnliftedType). Lift a -> IO (MutVar a)
newMutVar (MutArray a -> Lift (ArrayData# a)
forall a. MutArray a -> ArrayData a
Current MutArray a
arr0)
  Array a -> IO (Array a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutVar (ArrayData# a) -> Array a
forall a. ArrayVar a -> Array a
A MutVar (ArrayData# a)
v)

replicate :: Int -> a -> Array a
replicate :: forall a. Int -> a -> Array a
replicate Int
n a
x = IO (Array a) -> Array a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ do
  MutArray a
arr <- Int -> a -> IO (MutArray a)
forall a. Int -> a -> IO (MutArray a)
newMutArray Int
n a
x
  MutVar (ArrayData# a)
v <- Lift (ArrayData# a) -> IO (MutVar (ArrayData# a))
forall (a :: UnliftedType). Lift a -> IO (MutVar a)
newMutVar (MutArray a -> Lift (ArrayData# a)
forall a. MutArray a -> ArrayData a
Current MutArray a
arr)
  Array a -> IO (Array a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutVar (ArrayData# a) -> Array a
forall a. ArrayVar a -> Array a
A MutVar (ArrayData# a)
v)

copyInternal :: ArrayVar a -> IO (MutArray a)
copyInternal :: forall a. ArrayVar a -> IO (MutArray a)
copyInternal ArrayVar a
v = do
  Lift (ArrayData# a)
av <- ArrayVar a -> IO (Lift (ArrayData# a))
forall (a :: UnliftedType). MutVar a -> IO (Lift a)
readMutVar ArrayVar a
v
  case Lift (ArrayData# a)
av of
    Current MutArray a
arr -> MutArray a -> Int -> Int -> IO (MutArray a)
forall a. MutArray a -> Int -> Int -> IO (MutArray a)
cloneMutArray MutArray a
arr Int
0 (MutArray a -> Int
forall a. MutArray a -> Int
sizeofMutArray MutArray a
arr)
    -- _ -> error "Accessing old version"
    Diff Op a
op ArrayVar a
v' -> do
      MutArray a
clone <- ArrayVar a -> IO (MutArray a)
forall a. ArrayVar a -> IO (MutArray a)
copyInternal ArrayVar a
v'
      MutArray a -> Op a -> IO ()
forall a. MutArray a -> Op a -> IO ()
appOp MutArray a
clone Op a
op
      MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
clone

-- | Converting an array into a list. O(n)
toList :: Array a -> [a]
toList :: forall a. Array a -> [a]
toList (A ArrayVar a
v) = IO [a] -> [a]
forall a. IO a -> a
unsafeDupablePerformIO (IO [a] -> [a]) -> IO [a] -> [a]
forall a b. (a -> b) -> a -> b
$ do
  MutArray a
arr <- ArrayVar a -> IO (MutArray a)
forall a. ArrayVar a -> IO (MutArray a)
copyInternal ArrayVar a
v
  let n :: Int
n = MutArray a -> Int
forall a. MutArray a -> Int
sizeofMutArray MutArray a
arr
      go :: Int -> IO [a]
go Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        | Bool
otherwise = do
            a
x <- MutArray a -> Int -> IO a
forall a. MutArray a -> Int -> IO a
readMutArray MutArray a
arr Int
i
            [a]
xs <- Int -> IO [a]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
  Int -> IO [a]
go Int
0

-- | Indexing an array. O(1)
--
-- __WARNING:__ If you were to write your own 'swap' function. You might be
-- tempted to write it like this:
--
-- > swap :: Int -> Int -> Array a -> Array a
-- > swap !i !j !xs = set i (xs ! j) (set j (xs ! i) xs)
--
-- Unfortunately, this leaves the order between the reads and writes undefined.
-- And in practice, GHC picks the wrong order. To enforce that reads happen
-- before writes, you can use 'tag'. See its documentation for more info.
{-# INLINE (!) #-}
(!) :: Array a -> Int -> a
A ArrayVar a
v0 ! :: forall a. Array a -> Int -> a
! Int
i0 = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (ArrayVar a -> Int -> IO a
forall {a}. ArrayVar a -> Int -> IO a
go ArrayVar a
v0 Int
i0) where
  go :: ArrayVar a -> Int -> IO a
go ArrayVar a
v Int
i = do
    Lift (ArrayData# a)
dat <- ArrayVar a -> IO (Lift (ArrayData# a))
forall (a :: UnliftedType). MutVar a -> IO (Lift a)
readMutVar ArrayVar a
v
    case Lift (ArrayData# a)
dat of
      Current MutArray a
arr -> MutArray a -> Int -> IO a
forall a. MutArray a -> Int -> IO a
readMutArray MutArray a
arr Int
i
      -- _ -> error "Accessing old version"
      Diff (Set Int
j a
x) ArrayVar a
v'
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        | Bool
otherwise -> ArrayVar a -> Int -> IO a
go ArrayVar a
v' Int
i
      Diff (Swap Int
j1 Int
j2) ArrayVar a
v'
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j1 -> ArrayVar a -> Int -> IO a
go ArrayVar a
v' Int
j2
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j2 -> ArrayVar a -> Int -> IO a
go ArrayVar a
v' Int
j1
        | Bool
otherwise -> ArrayVar a -> Int -> IO a
go ArrayVar a
v' Int
i

data Token = Token (State# RealWorld)

returnToken :: a -> IO (a, Token)
returnToken :: forall a. a -> IO (a, Token)
returnToken a
x = (State# RealWorld -> (# State# RealWorld, (a, Token) #))
-> IO (a, Token)
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO (\State# RealWorld
s -> (# State# RealWorld
s , (a
x, State# RealWorld -> Token
Token State# RealWorld
s) #))

-- | Indexing an array. O(1)
--
-- The tuple and 'Token' serve two purposes:
--
-- - You can now separately force the evaluation of the tuple and the actual
--   array element
-- - You can use the 'Token' to with the 'tag' function on an array to force
--   the indexing to happen before the array can be written to.
{-# INLINE index #-}
index :: Int -> Array a -> (a, Token)
index :: forall a. Int -> Array a -> (a, Token)
index Int
i0 (A ArrayVar a
v0) = IO (a, Token) -> (a, Token)
forall a. IO a -> a
unsafeDupablePerformIO (ArrayVar a -> Int -> IO (a, Token)
forall {a}. ArrayVar a -> Int -> IO (a, Token)
go ArrayVar a
v0 Int
i0) where
  go :: ArrayVar a -> Int -> IO (a, Token)
go ArrayVar a
v Int
i = do
    Lift (ArrayData# a)
dat <- ArrayVar a -> IO (Lift (ArrayData# a))
forall (a :: UnliftedType). MutVar a -> IO (Lift a)
readMutVar ArrayVar a
v
    case Lift (ArrayData# a)
dat of
      Current MutArray a
arr -> MutArray a -> Int -> IO a
forall a. MutArray a -> Int -> IO a
readMutArray MutArray a
arr Int
i IO a -> (a -> IO (a, Token)) -> IO (a, Token)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (a, Token)
forall a. a -> IO (a, Token)
returnToken
      -- _ -> error "Accessing old version"
      Diff (Set Int
j a
x) ArrayVar a
xs
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> a -> IO (a, Token)
forall a. a -> IO (a, Token)
returnToken a
x
        | Bool
otherwise -> ArrayVar a -> Int -> IO (a, Token)
go ArrayVar a
xs Int
i
      Diff (Swap Int
j1 Int
j2) ArrayVar a
xs
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j1 -> ArrayVar a -> Int -> IO (a, Token)
go ArrayVar a
xs Int
j2
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j2 -> ArrayVar a -> Int -> IO (a, Token)
go ArrayVar a
xs Int
j1
        | Bool
otherwise -> ArrayVar a -> Int -> IO (a, Token)
go ArrayVar a
xs Int
i

-- | This is a no-op, but can be used to enforce an ordering between indexing
-- and other array operations, to avoid the overhead of indexing from older
-- versions of the array.
--
-- For example, swapping two elements in an array by using 'index'
-- and 'set' can be done like this:
--
-- > swap :: Int -> Int -> Array a -> Array a
-- > swap i j xs =
-- >   let (x, t1) = index i xs
-- >       (y, t2) = index j xs
-- >   in set i y (set j x (tag t1 (tag t2 xs)))
--
-- This ensures the indexing happens before the setting.
{-# NOINLINE tag #-}
tag :: Token -> Array a -> Array a
tag :: forall a. Token -> Array a -> Array a
tag (Token State# RealWorld
_) Array a
xs = Array a
xs

{-# INLINE invert #-}
invert :: MutArray a -> Op a -> IO (Op a)
invert :: forall a. MutArray a -> Op a -> IO (Op a)
invert MutArray a
_ (Swap Int
i Int
j) = Op a -> IO (Op a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Op a
forall a. Int -> Int -> Op a
Swap Int
i Int
j)
invert MutArray a
arr (Set Int
i a
_) = do
  a
y <- MutArray a -> Int -> IO a
forall a. MutArray a -> Int -> IO a
readMutArray MutArray a
arr Int
i
  Op a -> IO (Op a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> a -> Op a
forall a. Int -> a -> Op a
Set Int
i a
y)

{-# INLINE appOp #-}
appOp :: MutArray a -> Op a -> IO ()
appOp :: forall a. MutArray a -> Op a -> IO ()
appOp MutArray a
arr (Set Int
i a
x) = MutArray a -> Int -> a -> IO ()
forall a. MutArray a -> Int -> a -> IO ()
writeMutArray MutArray a
arr Int
i a
x
appOp MutArray a
arr (Swap Int
i Int
j) = do
  a
x <- MutArray a -> Int -> IO a
forall a. MutArray a -> Int -> IO a
readMutArray MutArray a
arr Int
i
  a
y <- MutArray a -> Int -> IO a
forall a. MutArray a -> Int -> IO a
readMutArray MutArray a
arr Int
j
  MutArray a -> Int -> a -> IO ()
forall a. MutArray a -> Int -> a -> IO ()
writeMutArray MutArray a
arr Int
i a
y
  MutArray a -> Int -> a -> IO ()
forall a. MutArray a -> Int -> a -> IO ()
writeMutArray MutArray a
arr Int
j a
x

{-# INLINE reversePointers #-}
reversePointers :: ArrayVar a -> IO (MutArray a)
reversePointers :: forall a. ArrayVar a -> IO (MutArray a)
reversePointers ArrayVar a
v = do
  Lift (ArrayData# a)
dat <- ArrayVar a -> IO (Lift (ArrayData# a))
forall (a :: UnliftedType). MutVar a -> IO (Lift a)
readMutVar ArrayVar a
v
  case Lift (ArrayData# a)
dat of
    Current MutArray a
arr -> MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
arr
    Diff Op a
op ArrayVar a
v' -> ArrayVar a -> Op a -> ArrayVar a -> IO (MutArray a)
forall a. ArrayVar a -> Op a -> ArrayVar a -> IO (MutArray a)
reversePointersDiff ArrayVar a
v Op a
op ArrayVar a
v'

-- this needs to be a separate function, because we want the good weather path
-- (where dat = Current ...) to inline and optimize. The recursion in this
-- function, which prevents inlining, thus needs to be extracted from
-- reversePointers.
reversePointersDiff :: ArrayVar a -> Op a -> ArrayVar a -> IO (MutArray a)
reversePointersDiff :: forall a. ArrayVar a -> Op a -> ArrayVar a -> IO (MutArray a)
reversePointersDiff ArrayVar a
v Op a
op ArrayVar a
v' = do
  Lift (ArrayData# a)
dat <- ArrayVar a -> IO (Lift (ArrayData# a))
forall (a :: UnliftedType). MutVar a -> IO (Lift a)
readMutVar ArrayVar a
v'
  MutArray a
arr <- case Lift (ArrayData# a)
dat of
    Current MutArray a
arr -> MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
arr
    Diff Op a
op' ArrayVar a
v'' -> ArrayVar a -> Op a -> ArrayVar a -> IO (MutArray a)
forall a. ArrayVar a -> Op a -> ArrayVar a -> IO (MutArray a)
reversePointersDiff ArrayVar a
v' Op a
op' ArrayVar a
v''
  Op a
op' <- MutArray a -> Op a -> IO (Op a)
forall a. MutArray a -> Op a -> IO (Op a)
invert MutArray a
arr Op a
op
  MutArray a -> Op a -> IO ()
forall a. MutArray a -> Op a -> IO ()
appOp MutArray a
arr Op a
op
  ArrayVar a -> Lift (ArrayData# a) -> IO ()
forall (a :: UnliftedType). MutVar a -> Lift a -> IO ()
writeMutVar ArrayVar a
v' (Op a -> ArrayVar a -> Lift (ArrayData# a)
forall a. Op a -> ArrayVar a -> ArrayData a
Diff Op a
op' ArrayVar a
v)
  MutArray a -> IO (MutArray a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutArray a
arr

{-# INLINE appDiffOp #-}
appDiffOp :: Op a -> Array a -> Array a
appDiffOp :: forall a. Op a -> Array a -> Array a
appDiffOp Op a
op (A ArrayVar a
v) = IO (Array a) -> Array a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ do
  MutArray a
arr <- ArrayVar a -> IO (MutArray a)
forall a. ArrayVar a -> IO (MutArray a)
reversePointers ArrayVar a
v
  Op a
op' <- MutArray a -> Op a -> IO (Op a)
forall a. MutArray a -> Op a -> IO (Op a)
invert MutArray a
arr Op a
op
  MutArray a -> Op a -> IO ()
forall a. MutArray a -> Op a -> IO ()
appOp MutArray a
arr Op a
op
  ArrayVar a
v' <- Lift (ArrayData# a) -> IO (ArrayVar a)
forall (a :: UnliftedType). Lift a -> IO (MutVar a)
newMutVar (MutArray a -> Lift (ArrayData# a)
forall a. MutArray a -> ArrayData a
Current MutArray a
arr)
  ArrayVar a -> Lift (ArrayData# a) -> IO ()
forall (a :: UnliftedType). MutVar a -> Lift a -> IO ()
writeMutVar ArrayVar a
v (Op a -> ArrayVar a -> Lift (ArrayData# a)
forall a. Op a -> ArrayVar a -> ArrayData a
Diff Op a
op' ArrayVar a
v')
  Array a -> IO (Array a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayVar a -> Array a
forall a. ArrayVar a -> Array a
A ArrayVar a
v')

-- | Update the array element at a given position to a new value. O(1)
{-# INLINE set #-}
set :: Int -> a -> Array a -> Array a
set :: forall a. Int -> a -> Array a -> Array a
set Int
i a
x = Op a -> Array a -> Array a
forall a. Op a -> Array a -> Array a
appDiffOp (Int -> a -> Op a
forall a. Int -> a -> Op a
Set Int
i a
x)

-- | Swap two elements in an array. O(1)
{-# INLINE swap #-}
swap :: Int -> Int -> Array a -> Array a
swap :: forall a. Int -> Int -> Array a -> Array a
swap Int
i Int
j = Op a -> Array a -> Array a
forall a. Op a -> Array a -> Array a
appDiffOp (Int -> Int -> Op a
forall a. Int -> Int -> Op a
Swap Int
i Int
j)

-- | Copy an array. O(n)
-- This detaches any future updates from old versions of the array.
-- Use this when you know you will be updating a large part of an array.
copy :: Array a -> Array a
copy :: forall a. Array a -> Array a
copy (A ArrayVar a
v) = IO (Array a) -> Array a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ do
  MutArray a
arr <- ArrayVar a -> IO (MutArray a)
forall a. ArrayVar a -> IO (MutArray a)
copyInternal ArrayVar a
v
  ArrayVar a
var <- Lift (ArrayData# a) -> IO (ArrayVar a)
forall (a :: UnliftedType). Lift a -> IO (MutVar a)
newMutVar (MutArray a -> Lift (ArrayData# a)
forall a. MutArray a -> ArrayData a
Current MutArray a
arr)
  Array a -> IO (Array a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayVar a -> Array a
forall a. ArrayVar a -> Array a
A ArrayVar a
var)

unsafeAppDiffOp :: Op a -> Array a -> Array a
unsafeAppDiffOp :: forall a. Op a -> Array a -> Array a
unsafeAppDiffOp Op a
op (A ArrayVar a
v) = IO (Array a) -> Array a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Array a) -> Array a) -> IO (Array a) -> Array a
forall a b. (a -> b) -> a -> b
$ do
  ArrayVar a -> IO (Lift (ArrayData# a))
forall (a :: UnliftedType). MutVar a -> IO (Lift a)
readMutVar ArrayVar a
v IO (Lift (ArrayData# a))
-> (Lift (ArrayData# a) -> IO (Array a)) -> IO (Array a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Current MutArray a
arr -> do
      MutArray a -> Op a -> IO ()
forall a. MutArray a -> Op a -> IO ()
appOp MutArray a
arr Op a
op
      Array a -> IO (Array a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArrayVar a -> Array a
forall a. ArrayVar a -> Array a
A ArrayVar a
v) -- reusing 'v' like this avoids allocating, but it will cause
                 -- old versions to silently give wrong results.
                 -- I don't see an easy option that avoids silent breakage
    Lift (ArrayData# a)
_ -> String -> IO (Array a)
forall a. HasCallStack => String -> a
error String
"Unsafe operation encountered old array version."