Merge pull request #89 from purescript/iterator-groupby-2

Iterator groupby 2

Author: hdgarrood

bower.json

@@ -22,7 +22,8 @@
     "purescript-st": "^2.0.0",
     "purescript-tailrec": "^2.0.0",
     "purescript-tuples": "^3.0.0",
-    "purescript-unfoldable": "^2.0.0"
+    "purescript-unfoldable": "^2.0.0",
+    "purescript-unsafe-coerce": "^2.0.0"
   },
   "devDependencies": {
     "purescript-assert": "^2.0.0",

src/Data/Array.purs

@@ -111,12 +111,13 @@ module Data.Array
   ) where
 
 import Prelude
-
 import Control.Alt ((<|>))
 import Control.Alternative (class Alternative)
 import Control.Lazy (class Lazy, defer)
 import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM2)
-
+import Control.Monad.ST (pureST)
+import Data.Array.ST (unsafeFreeze, emptySTArray, pushSTArray)
+import Data.Array.ST.Iterator (iterator, iterate, pushWhile)
 import Data.Foldable (class Foldable, foldl, foldr)
 import Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports
 import Data.Maybe (Maybe(..), maybe, isJust, fromJust)
@@ -125,7 +126,6 @@ import Data.Traversable (scanl, scanr) as Exports
 import Data.Traversable (sequence, traverse)
 import Data.Tuple (Tuple(..))
 import Data.Unfoldable (class Unfoldable, unfoldr)
-
 import Partial.Unsafe (unsafePartial)
 
 -- | Convert an `Array` into an `Unfoldable` structure.
@@ -548,14 +548,16 @@ group' = group <<< sort
 -- | Group equal, consecutive elements of an array into arrays, using the
 -- | specified equivalence relation to detemine equality.
 groupBy :: forall a. (a -> a -> Boolean) -> Array a -> Array (NonEmpty Array a)
-groupBy op = go []
-  where
-  go :: Array (NonEmpty Array a) -> Array a -> Array (NonEmpty Array a)
-  go acc xs = case uncons xs of
-    Just o ->
-      let sp = span (op o.head) o.tail
-      in go ((o.head :| sp.init) : acc) sp.rest
-    Nothing -> reverse acc
+groupBy op xs =
+  pureST do
+    result <- emptySTArray
+    iter <- iterator (xs !! _)
+    iterate iter \x -> void do
+      sub <- emptySTArray
+      pushWhile (op x) iter sub
+      sub_ <- unsafeFreeze sub
+      pushSTArray result (x :| sub_)
+    unsafeFreeze result
 
 -- | Remove the duplicates from an array, creating a new array.
 nub :: forall a. Eq a => Array a -> Array a

src/Data/Array/ST.purs

@@ -13,13 +13,16 @@ module Data.Array.ST
   , pushAllSTArray
   , spliceSTArray
   , freeze, thaw
+  , unsafeFreeze
   , toAssocArray
   ) where
 
+import Prelude
 import Control.Monad.Eff (Eff)
 import Control.Monad.ST (ST)
 
 import Data.Maybe (Maybe(..))
+import Unsafe.Coerce (unsafeCoerce)
 
 -- | A reference to a mutable array.
 -- |
@@ -33,6 +36,8 @@ foreign import data STArray :: * -> * -> *
 -- | An element and its index.
 type Assoc a = { value :: a, index :: Int }
 
+-- | **DEPRECATED**: Use `unsafeFreeze` together with `runST` instead.
+-- |
 -- | Freeze a mutable array, creating an immutable array. Use this function as you would use
 -- | `runST` to freeze a mutable reference.
 -- |
@@ -42,6 +47,11 @@ foreign import runSTArray
    . (forall h. Eff (st :: ST h | r) (STArray h a))
   -> Eff r (Array a)
 
+-- | O(1). Convert a mutable array to an immutable array, without copying. The mutable
+-- | array must not be mutated afterwards.
+unsafeFreeze :: forall a r h. STArray h a -> Eff (st :: ST h | r) (Array a)
+unsafeFreeze = pure <<< (unsafeCoerce :: STArray h a -> Array a)
+
 -- | Create an empty mutable array.
 foreign import emptySTArray :: forall a h r. Eff (st :: ST h | r) (STArray h a)
 

src/Data/Array/ST/Iterator.purs

@@ -0,0 +1,77 @@
+module Data.Array.ST.Iterator
+  ( Iterator
+  , iterator
+  , iterate
+  , next
+  , peek
+  , exhausted
+  , pushWhile
+  , pushAll
+  ) where
+
+import Prelude
+import Control.Monad.Eff (Eff, whileE)
+import Control.Monad.ST (ST, STRef, newSTRef, readSTRef, writeSTRef, modifySTRef)
+import Data.Array.ST (STArray, pushSTArray)
+
+import Data.Maybe (Maybe(..), isNothing)
+
+-- | This type provides a slightly easier way of iterating over an array's
+-- | elements in an STArray computation, without having to keep track of
+-- | indices.
+data Iterator h a = Iterator (Int -> Maybe a) (STRef h Int)
+
+-- | Make an Iterator given an indexing function into an array (or anything
+-- | else). If `xs :: Array a`, the standard way to create an iterator over
+-- | `xs` is to use `iterator (xs !! _)`, where `(!!)` comes from `Data.Array`.
+iterator :: forall a h r. (Int -> Maybe a) -> Eff (st :: ST h | r) (Iterator h a)
+iterator f =
+  Iterator f <$> newSTRef 0
+
+-- | Perform an action once for each item left in an iterator. If the action
+-- | itself also advances the same iterator, `iterate` will miss those items
+-- | out.
+iterate :: forall a h r. Iterator h a -> (a -> Eff (st :: ST h | r) Unit) -> Eff (st :: ST h | r) Unit
+iterate iter f = do
+  break <- newSTRef false
+  whileE (not <$> readSTRef break) do
+    mx <- next iter
+    case mx of
+      Just x -> f x
+      Nothing -> void $ writeSTRef break true
+
+-- | Get the next item out of an iterator, advancing it. Returns Nothing if the
+-- | Iterator is exhausted.
+next :: forall a h r. Iterator h a -> Eff (st :: ST h | r) (Maybe a)
+next (Iterator f currentIndex) = do
+  i <- readSTRef currentIndex
+  modifySTRef currentIndex (_ + 1)
+  pure (f i)
+
+-- | Get the next item out of an iterator without advancing it.
+peek :: forall a h r. Iterator h a -> Eff (st :: ST h | r) (Maybe a)
+peek (Iterator f currentIndex) = do
+  i <- readSTRef currentIndex
+  pure (f i)
+
+-- | Check whether an iterator has been exhausted.
+exhausted :: forall a h r. Iterator h a -> Eff (st :: ST h | r) Boolean
+exhausted = map isNothing <<< peek
+
+-- | Extract elements from an iterator and push them on to an STArray for as
+-- | long as those elements satisfy a given predicate.
+pushWhile :: forall a h r. (a -> Boolean) -> Iterator h a -> STArray h a -> Eff (st :: ST h | r) Unit
+pushWhile p iter array = do
+  break <- newSTRef false
+  whileE (not <$> readSTRef break) do
+    mx <- peek iter
+    case mx of
+      Just x | p x -> do
+        pushSTArray array x
+        void $ next iter
+      _ ->
+        void $ writeSTRef break true
+
+-- | Push the entire remaining contents of an iterator onto an STArray.
+pushAll :: forall a h r. Iterator h a -> STArray h a -> Eff (st :: ST h | r) Unit
+pushAll = pushWhile (const true)

test/Test/Data/Array/ST.purs

@@ -1,157 +1,157 @@
 module Test.Data.Array.ST (testArrayST) where
 
 import Prelude
-
-import Control.Monad.Eff (runPure, Eff)
+import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (log, CONSOLE)
-import Control.Monad.ST (runST)
-
-import Data.Array.ST (toAssocArray, thaw, spliceSTArray, runSTArray, pokeSTArray, emptySTArray, peekSTArray, pushAllSTArray, pushSTArray, freeze)
+import Control.Monad.ST (ST, pureST)
+import Data.Array.ST (STArray, emptySTArray, freeze, peekSTArray, pokeSTArray, pushAllSTArray, pushSTArray, spliceSTArray, thaw, toAssocArray, unsafeFreeze)
 import Data.Foldable (all)
 import Data.Maybe (Maybe(..), isNothing)
-
 import Test.Assert (assert, ASSERT)
 
+run :: forall a. (forall h. Eff (st :: ST h) (STArray h a)) -> Array a
+run act = pureST (act >>= unsafeFreeze)
+
 testArrayST :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
 testArrayST = do
 
   log "emptySTArray should produce an empty array"
 
-  assert $ runPure (runSTArray emptySTArray) == nil
+  assert $ run emptySTArray == nil
 
   log "thaw should produce an STArray from a standard array"
 
-  assert $ runPure (runSTArray (thaw [1, 2, 3])) == [1, 2, 3]
+  assert $ run (thaw [1, 2, 3]) == [1, 2, 3]
 
   log "freeze should produce a standard array from an STArray"
 
-  assert $ runPure (runST (do
+  assert $ pureST (do
     arr <- thaw [1, 2, 3]
-    freeze arr)) == [1, 2, 3]
+    freeze arr) == [1, 2, 3]
 
   log "pushSTArray should append a value to the end of the array"
 
-  assert $ runPure (runSTArray (do
+  assert $ run (do
     arr <- emptySTArray
     pushSTArray arr 1
     pushSTArray arr 2
-    pure arr)) == [1, 2]
+    pure arr) == [1, 2]
 
-  assert $ runPure (runSTArray (do
+  assert $ run (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 $ run (do
     arr <- emptySTArray
     pushAllSTArray arr [1, 2]
-    pure arr)) == [1, 2]
+    pure arr) == [1, 2]
 
-  assert $ runPure (runSTArray (do
+  assert $ run (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"
 
-  assert $ isNothing $ runPure (runST (do
+  assert $ isNothing $ pureST (do
     arr <- emptySTArray
-    peekSTArray arr 0))
+    peekSTArray arr 0)
 
-  assert $ isNothing $ runPure (runST (do
+  assert $ isNothing $ pureST (do
     arr <- thaw [1]
-    peekSTArray arr 1))
+    peekSTArray arr 1)
 
-  assert $ isNothing $ runPure (runST (do
+  assert $ isNothing $ pureST (do
     arr <- emptySTArray
-    peekSTArray arr (-1)))
+    peekSTArray arr (-1))
 
   log "peekSTArray should return the value at the specified index"
 
-  assert $ runPure (runST (do
+  assert $ pureST (do
     arr <- thaw [1]
-    peekSTArray arr 0)) == Just 1
+    peekSTArray arr 0) == Just 1
 
-  assert $ runPure (runST (do
+  assert $ pureST (do
     arr <- thaw [1, 2, 3]
-    peekSTArray arr 2)) == Just 3
+    peekSTArray arr 2) == Just 3
 
   log "pokeSTArray should return true when a value has been updated succesfully"
 
-  assert $ runPure (runST (do
+  assert $ pureST (do
     arr <- thaw [1]
-    pokeSTArray arr 0 10))
+    pokeSTArray arr 0 10)
 
-  assert $ runPure (runST (do
+  assert $ pureST (do
     arr <- thaw [1, 2, 3]
-    pokeSTArray arr 2 30))
+    pokeSTArray arr 2 30)
 
   log "pokeSTArray should return false when attempting to modify a value outside the array bounds"
 
-  assert $ not $ runPure (runST (do
+  assert $ not $ pureST (do
     arr <- emptySTArray
-    pokeSTArray arr 0 10))
+    pokeSTArray arr 0 10)
 
-  assert $ not $ runPure (runST (do
+  assert $ not $ pureST (do
     arr <- thaw [1, 2, 3]
-    pokeSTArray arr 3 100))
+    pokeSTArray arr 3 100)
 
-  assert $ not $ runPure (runST (do
+  assert $ not $ pureST (do
     arr <- thaw [1, 2, 3]
-    pokeSTArray arr (-1) 100))
+    pokeSTArray arr (-1) 100)
 
   log "pokeSTArray should replace the value at the specified index"
 
-  assert $ runPure (runSTArray (do
+  assert $ run (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 $ run (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 $ run (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"
 
-  assert $ runPure (runST (do
+  assert $ pureST (do
     arr <- thaw [1, 2, 3, 4, 5]
-    spliceSTArray arr 1 3 [])) == [2, 3, 4]
+    spliceSTArray arr 1 3 []) == [2, 3, 4]
 
   log "spliceSTArray should be able to insert multiple items at a specified index"
 
-  assert $ runPure (runSTArray (do
+  assert $ run (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 $ run (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"
 
-  assert $ all (\{ value: v, index: i } -> v == i + 1) $ runPure (runST (do
+  assert $ all (\{ value: v, index: i } -> v == i + 1) $ pureST (do
     arr <- thaw [1, 2, 3, 4, 5]
-    toAssocArray arr))
+    toAssocArray arr)
 
-  assert $ all (\{ value: v, index: i } -> v == (i + 1) * 10) $ runPure (runST (do
+  assert $ all (\{ value: v, index: i } -> v == (i + 1) * 10) $ pureST (do
     arr <- thaw [10, 20, 30, 40, 50]
-    toAssocArray arr))
+    toAssocArray arr)
 
 nil :: Array Int
 nil = []