@@ -28,6 +28,7 @@ module Fleet.Array
28
28
, toList
29
29
, (!)
30
30
, index
31
+ , tag
31
32
, set
32
33
, copy
33
34
, swap
@@ -36,7 +37,6 @@ module Fleet.Array
36
37
37
38
import Prelude hiding (replicate )
38
39
39
- import Data.Tuple (Solo (MkSolo ))
40
40
import GHC.Exts hiding (fromList , toList , Lifted )
41
41
42
42
import Data.Kind (Type )
@@ -157,25 +157,55 @@ A v0 ! i0 = unsafeDupablePerformIO (go v0 i0) where
157
157
| i == j2 -> go v' j1
158
158
| otherwise -> go v' i
159
159
160
+ data Token = Token (State # RealWorld )
161
+
162
+ returnToken :: a -> IO (a , Token )
163
+ returnToken x = IO (\ s -> (# s , (x, Token s) # ))
164
+
160
165
-- | Indexing an array. O(1)
161
- -- Using the 'Solo' constructor, you can sequence indexing to happen before
162
- -- future updates without having to evaluate the element itself.
166
+ --
167
+ -- The tuple and 'Token' serve two purposes:
168
+ --
169
+ -- - You can now separately force the evaluation of the tuple and the actual
170
+ -- array element
171
+ -- - You can use the 'Token' to with the 'tag' function on an array to force
172
+ -- the indexing to happen before the array can be written to.
163
173
{-# INLINE index #-}
164
- index :: Int -> Array a -> Solo a
174
+ index :: Int -> Array a -> ( a , Token )
165
175
index i0 (A v0) = unsafeDupablePerformIO (go v0 i0) where
166
176
go v i = do
167
177
dat <- readMutVar v
168
178
case dat of
169
- Current arr -> MkSolo <$> readMutArray arr i
179
+ Current arr -> readMutArray arr i >>= returnToken
170
180
-- _ -> error "Accessing old version"
171
181
Diff (Set j x) xs
172
- | i == j -> pure ( MkSolo x)
182
+ | i == j -> returnToken x
173
183
| otherwise -> go xs i
174
184
Diff (Swap j1 j2) xs
175
185
| i == j1 -> go xs j2
176
186
| i == j2 -> go xs j1
177
187
| otherwise -> go xs i
178
188
189
+ -- | This is a no-op, but can be used to enforce an ordering between indexing
190
+ -- and other array operations, to avoid the overhead of indexing from older
191
+ -- versions of the array.
192
+ --
193
+ -- For example, swapping two elements in an array by using 'index'
194
+ -- and 'set' can be done like this:
195
+ --
196
+ -- @
197
+ -- swap :: Int -> Int -> Array a -> Array a
198
+ -- swap i j xs =
199
+ -- let (x, t1) = index i xs
200
+ -- (y, t2) = index j xs
201
+ -- in set i y (set j x (tag t1 (tag t2 xs)))
202
+ -- @
203
+ --
204
+ -- This ensures the indexing happens before the setting.
205
+ {-# NOINLINE tag #-}
206
+ tag :: Token -> Array a -> Array a
207
+ tag (Token _) xs = xs
208
+
179
209
{-# INLINE invert #-}
180
210
invert :: MutArray a -> Op a -> IO (Op a )
181
211
invert _ (Swap i j) = pure (Swap i j)
0 commit comments