Restrict to a closed row in runSTArray

Author: hdgarrood

src/Data/Array.purs

@@ -115,7 +115,7 @@ import Prelude
 import Control.Alt ((<|>))
 import Control.Alternative (class Alternative)
 import Control.Lazy (class Lazy, defer)
-import Control.Monad.Eff (Eff, runPure)
+import Control.Monad.Eff (Eff)
 import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM2)
 import Control.Monad.ST (ST)
 
@@ -554,21 +554,20 @@ group' = group <<< sort
 -- | specified equivalence relation to detemine equality.
 groupBy :: forall a. (a -> a -> Boolean) -> Array a -> Array (NonEmpty Array a)
 groupBy op xs =
-  runPure do
-    runGroupedSTArray do
-      result <- emptySTArray
-      iter <- iterator (xs !! _)
-      iterate iter \x -> do
-        sub <- emptySTArray
-        pushSTArray result (x :| sub)
-        pushWhile (op x) iter sub
-      pure result
+  runGroupedSTArray do
+    result <- emptySTArray
+    iter <- iterator (xs !! _)
+    iterate iter \x -> do
+      sub <- emptySTArray
+      pushSTArray result (x :| sub)
+      pushWhile (op x) iter sub
+    pure result
   where
   runGroupedSTArray
-    :: forall b r
-    . (forall h. Eff (st :: ST h | r) (STArray h (NonEmpty (STArray h) b)))
-    -> Eff r (Array (NonEmpty Array b))
-  runGroupedSTArray a = map unwrap (runSTArray' (map Grouped a))
+    :: forall b
+     . (forall h. Eff (st :: ST h) (STArray h (NonEmpty (STArray h) b)))
+    -> Array (NonEmpty Array b)
+  runGroupedSTArray a = unwrap (runSTArray' (map Grouped a))
 
 newtype Grouped a arr = Grouped (arr (NonEmpty arr a))
 derive instance newtypeGrouped :: Newtype (Grouped a arr) _

src/Data/Array/ST.purs

@@ -18,7 +18,7 @@ module Data.Array.ST
   ) where
 
 import Prelude
-import Control.Monad.Eff (Eff)
+import Control.Monad.Eff (Eff, Pure, runPure)
 import Control.Monad.ST (ST)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype, unwrap)
@@ -43,25 +43,41 @@ derive instance newtypeId :: Newtype (Id a f) _
 -- | Freeze a mutable array, creating an immutable array. Use this function as you would use
 -- | `runST` to freeze a mutable reference.
 -- |
--- | The rank-2 type prevents the reference from escaping the scope of `runSTArray`.
+-- | The rank-2 type prevents the reference from escaping the scope of `runSTArray'`,
+-- | and the closed row on the `Eff` computation prevents the reference from
+-- | escaping into other parts of your program via native effects such as `setTimeout`.
+-- |
+-- | You can also return an immutable copy of an `STArray` from an `ST` computation
+-- | by using `freeze` combined with `runST`. However, when possible, you should
+-- | prefer this function, because it is `O(1)`. By contrast, `freeze` must copy the
+-- | underlying array and is therefore `O(n)`.
 runSTArray
-  :: forall a r
-   . (forall h. Eff (st :: ST h | r) (STArray h a))
-  -> Eff r (Array a)
-runSTArray a = map unwrap (runSTArray' (map Id a))
+  :: forall a
+   . (forall h. Eff (st :: ST h) (STArray h a))
+  -> Array a
+runSTArray a = unwrap (runSTArray' (map Id a))
 
 -- | Freeze all mutable arrays in some structure, creating a version of the
 -- | same structure where all mutable arrays are replaced with immutable
 -- | arrays. Use this function as you would use `runST` to freeze a mutable
 -- | reference.
 -- |
--- | The rank-2 type prevents the reference from escaping the scope of `runSTArray'`.
+-- | The rank-2 type prevents the reference from escaping the scope of `runSTArray'`,
+-- | and the closed row on the `Eff` computation prevents the reference from
+-- | escaping into other parts of your program via native effects such as `setTimeout`.
+-- |
+-- | You can also return an immutable copy of an `STArray` from an `ST` computation
+-- | by using `freeze` combined with `runST`. However, when possible, you should
+-- | prefer this function, because it is `O(1)`. By contrast, `freeze` must copy the
+-- | underlying array and is therefore `O(n)`.
 runSTArray'
-  :: forall f r
-   . (forall h. Eff (st :: ST h | r) (f (STArray h)))
-  -> Eff r (f Array)
-runSTArray' =
-  unsafeCoerce
+  :: forall f
+   . (forall h. Eff (st :: ST h) (f (STArray h)))
+  -> f Array
+runSTArray' x = runPure (go x)
+  where
+  go :: (forall h. Eff (st :: ST h) (f (STArray h))) -> Pure (f Array)
+  go = unsafeCoerce
 
 -- | Create an empty mutable array.
 foreign import emptySTArray :: forall a h r. Eff (st :: ST h | r) (STArray h a)

test/Test/Data/Array/ST.purs

@@ -17,11 +17,11 @@ testArrayST = do
 
   log "emptySTArray should produce an empty array"
 
-  assert $ runPure (runSTArray emptySTArray) == nil
+  assert $ runSTArray emptySTArray == nil
 
   log "thaw should produce an STArray from a standard array"
 
-  assert $ runPure (runSTArray (thaw [1, 2, 3])) == [1, 2, 3]
+  assert $ runSTArray (thaw [1, 2, 3]) == [1, 2, 3]
 
   log "freeze should produce a standard array from an STArray"
 
@@ -31,28 +31,28 @@ testArrayST = do
 
   log "pushSTArray should append a value to the end of the array"
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- emptySTArray
     pushSTArray arr 1
     pushSTArray arr 2
-    pure arr)) == [1, 2]
+    pure arr) == [1, 2]
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- thaw [1, 2, 3]
     pushSTArray arr 4
-    pure arr)) == [1, 2, 3, 4]
+    pure arr) == [1, 2, 3, 4]
 
   log "pushAllSTArray should append multiple values to the end of the array"
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- emptySTArray
     pushAllSTArray arr [1, 2]
-    pure arr)) == [1, 2]
+    pure arr) == [1, 2]
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- thaw [1, 2, 3]
     pushAllSTArray arr [4, 5, 6]
-    pure arr)) == [1, 2, 3, 4, 5, 6]
+    pure arr) == [1, 2, 3, 4, 5, 6]
 
   log "peekSTArray should return Nothing when peeking a value outside the array bounds"
 
@@ -104,24 +104,24 @@ testArrayST = do
 
   log "pokeSTArray should replace the value at the specified index"
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- thaw [1]
     pokeSTArray arr 0 10
-    pure arr)) == [10]
+    pure arr) == [10]
 
   log "pokeSTArray should do nothing when attempting to modify a value outside the array bounds"
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- thaw [1]
     pokeSTArray arr 1 2
-    pure arr)) == [1]
+    pure arr) == [1]
 
   log "spliceSTArray should be able to delete multiple items at a specified index"
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- thaw [1, 2, 3, 4, 5]
     spliceSTArray arr 1 3 []
-    pure arr)) == [1, 5]
+    pure arr) == [1, 5]
 
   log "spliceSTArray should return the items removed"
 
@@ -131,17 +131,17 @@ testArrayST = do
 
   log "spliceSTArray should be able to insert multiple items at a specified index"
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- thaw [1, 2, 3, 4, 5]
     spliceSTArray arr 1 0 [0, 100]
-    pure arr)) == [1, 0, 100, 2, 3, 4, 5]
+    pure arr) == [1, 0, 100, 2, 3, 4, 5]
 
   log "spliceSTArray should be able to delete and insert at the same time"
 
-  assert $ runPure (runSTArray (do
+  assert $ runSTArray (do
     arr <- thaw [1, 2, 3, 4, 5]
     spliceSTArray arr 1 2 [0, 100]
-    pure arr)) == [1, 0, 100, 4, 5]
+    pure arr) == [1, 0, 100, 4, 5]
 
   log "toAssocArray should return all items in the array with the correct indices and values"