Merge pull request #92 from sammthomson/lazierlazylist

Fixing several stack-unsafe functions in Data.List.Lazy

Author: paf31

src/Data/List/Lazy.purs

@@ -186,10 +186,7 @@ null = isNothing <<< uncons
 -- |
 -- | Running time: `O(n)`
 length :: forall a. List a -> Int
-length xs = go (step xs)
-  where
-  go Nil = 0
-  go (Cons _ xs') = 1 + go (step xs')
+length = foldl (\l _ -> l + 1) 0
 
 --------------------------------------------------------------------------------
 -- Extending arrays ------------------------------------------------------------
@@ -386,10 +383,7 @@ alterAt n f xs = List (go n <$> unwrap xs)
 -- |
 -- | Running time: `O(n)`
 reverse :: forall a. List a -> List a
-reverse = go nil <<< step
-  where
-  go acc Nil = acc
-  go acc (Cons x xs) = go (cons x acc) (step xs)
+reverse xs = Z.defer \_ -> foldl (flip cons) nil xs
 
 -- | Flatten a list of lists.
 -- |

src/Data/List/Lazy/Types.purs

@@ -98,43 +98,35 @@ instance functorList :: Functor List where
     go (Cons x xs') = Cons (f x) (f <$> xs')
 
 instance foldableList :: Foldable List where
-  foldr o b xs = go (step xs)
-    where
-    go Nil = b
-    go (Cons a as) = a `o` foldr o b as
+  -- calls foldl on the reversed list
+  foldr op z xs = foldl (flip op) z (rev xs) where
+    rev = foldl (flip cons) nil
 
-  foldl o b xs = go (step xs)
-    where
-    go Nil = b
-    go (Cons a as) = foldl o (b `o` a) as
+  foldl = go where
+    -- `go` is needed to ensure the function is tail-call optimized
+    go op b xs = case step xs of
+      Nil -> b
+      Cons hd tl -> go op (b `op` hd) tl
 
-  foldMap f xs = go (step xs)
-    where
-    go Nil = mempty
-    go (Cons x xs') = f x <> foldMap f xs'
+  foldMap f = foldl (\b a -> b <> f a) mempty
 
 instance unfoldableList :: Unfoldable List where
-  unfoldr f b = go (f b)
-    where
-    go Nothing = nil
-    go (Just (Tuple a b')) = a : Z.defer \_ -> go (f b')
+  unfoldr = go where
+    go f b = Z.defer \_ -> case f b of
+      Nothing -> nil
+      Just (Tuple a b') -> a : go f b'
 
 instance traversableList :: Traversable List where
-  traverse f xs = go (step xs)
-    where
-    go Nil = pure nil
-    go (Cons x xs') = cons <$> f x <*> traverse f xs'
+  traverse f =
+    foldr (\a b -> cons <$> f a <*> b) (pure nil)
 
-  sequence xs = go (step xs)
-    where
-    go Nil = pure nil
-    go (Cons x xs') = cons <$> x <*> sequence xs'
+  sequence = traverse id
 
 instance applyList :: Apply List where
   apply = ap
 
 instance applicativeList :: Applicative List where
-  pure = flip cons nil
+  pure a = a : nil
 
 instance bindList :: Bind List where
   bind xs f = List (go <$> unwrap xs)
@@ -170,7 +162,8 @@ instance extendList :: Extend List where
 newtype NonEmptyList a = NonEmptyList (Lazy (NonEmpty List a))
 
 toList :: forall a. NonEmptyList a -> List a
-toList (NonEmptyList nel) = case force nel of x :| xs -> x : xs
+toList (NonEmptyList nel) = Z.defer \_ ->
+  case force nel of x :| xs -> x : xs
 
 derive instance newtypeNonEmptyList :: Newtype (NonEmptyList a) _
 

test/Test/Data/List/Lazy.purs

@@ -7,10 +7,12 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log)
 
 import Data.Lazy as Z
-import Data.List.Lazy (List, nil, cons, singleton, transpose, take, iterate, filter, uncons, foldM, range, unzip, zip, length, zipWithA, replicate, repeat, zipWith, intersectBy, intersect, deleteBy, delete, unionBy, union, nubBy, nub, groupBy, group, span, dropWhile, drop, takeWhile, slice, catMaybes, mapMaybe, filterM, concat, concatMap, reverse, alterAt, modifyAt, updateAt, deleteAt, insertAt, findLastIndex, findIndex, elemLastIndex, elemIndex, init, tail, last, head, insertBy, insert, snoc, null, replicateM, fromFoldable, (:), (\\), (!!))
+import Data.List.Lazy (List, nil, cons, foldl, foldr, foldMap, singleton, transpose, take, iterate, filter, uncons, foldM, range, unzip, zip, length, zipWithA, replicate, repeat, zipWith, intersectBy, intersect, deleteBy, delete, unionBy, union, nubBy, nub, groupBy, group, span, dropWhile, drop, takeWhile, slice, catMaybes, mapMaybe, filterM, concat, concatMap, reverse, alterAt, modifyAt, updateAt, deleteAt, insertAt, findLastIndex, findIndex, elemLastIndex, elemIndex, init, tail, last, head, insertBy, insert, snoc, null, replicateM, fromFoldable, (:), (\\), (!!))
 import Data.List.Lazy.NonEmpty as NEL
 import Data.Maybe (Maybe(..), isNothing, fromJust)
+import Data.Monoid.Additive (Additive(..))
 import Data.NonEmpty ((:|))
+import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
 
 import Partial.Unsafe (unsafePartial)
@@ -22,6 +24,31 @@ testListLazy = do
   let
     l = fromFoldable
     nel xxs = NEL.NonEmptyList (Z.defer \_ -> xxs)
+    longList = range 1 100000
+
+  log "append should be stack-safe"
+  assert $ length (longList <> longList) == (2 * length longList)
+
+  log "map should be stack-safe"
+  assert $ (last $ (_ + 1) <$> longList) == ((_ + 1) <$> last longList)
+
+  log "foldl should be stack-safe"
+  void $ pure $ foldl (+) 0 longList
+
+  log "foldr should be stack-safe"
+  void $ pure $ foldr (+) 0 longList
+
+  log "foldMap should be stack-safe"
+  void $ pure $ foldMap Additive longList
+
+  log "foldMap should be left-to-right"
+  assert $ foldMap show (range 1 5) == "12345"
+
+  log "traverse should be stack-safe"
+  assert $ ((traverse Just longList) >>= last) == last longList
+
+  log "bind should be stack-safe"
+  void $ pure $ last $ longList >>= pure
 
   log "singleton should construct an list with a single value"
   assert $ singleton 1 == l [1]
@@ -57,6 +84,9 @@ testListLazy = do
   log "null should return true for an empty list"
   assert $ null nil' == true
 
+  log "length should be stack-safe"
+  assert $ length longList == 100000
+
   log "length should return the number of items in an list"
   assert $ length nil' == 0
   assert $ length (l [1]) == 1
@@ -66,6 +96,9 @@ testListLazy = do
   assert $ l [1, 2, 3] `snoc` 4 == l [1, 2, 3, 4]
   assert $ nil' `snoc` 1 == l [1]
 
+  log "insert should be stack-safe"
+  assert $ last (insert 100001 longList) == Just 100001
+
   log "insert should add an item at the appropriate place in a sorted list"
   assert $ insert 1.5 (l [1.0, 2.0, 3.0]) == l [1.0, 1.5, 2.0, 3.0]
   assert $ insert 4 (l [1, 2, 3]) == l [1, 2, 3, 4]
@@ -167,6 +200,9 @@ testListLazy = do
   assert $ (reverse (l [1, 2, 3])) == l [3, 2, 1]
   assert $ (reverse nil') == nil'
 
+  log "reverse should be stack-safe"
+  assert $ head (reverse longList) == last longList
+
   log "concat should join an list of lists"
   assert $ (concat (l [l [1, 2], l [3, 4]])) == l [1, 2, 3, 4]
   assert $ (concat (l [l [1], nil'])) == l [1]