Make >< build its result eagerly (#277)
authorDavid Feuer <>
Tue, 31 May 2016 17:55:37 +0000 (13:55 -0400)
committerDavid Feuer <>
Tue, 31 May 2016 17:55:37 +0000 (13:55 -0400)
Previously, `><` only built the top of the tree,
leaving the rest suspended lazily. Now it rebuilds
eagerly, using the full time allocated to it. The
improvements on the `splitAt/append` benchmark are
modest but meaningful. More importantly, it should no
longer be possible to use `><` to produce large chains
of thunks.

Fixes #274

Old: benchmarking splitAt/append/10
time                 1.056 ms   (1.050 ms .. 1.065 ms)
                     0.995 R²   (0.983 R² .. 1.000 R²)
mean                 1.073 ms   (1.057 ms .. 1.147 ms)
std dev              97.06 μs   (9.638 μs .. 221.7 μs)
variance introduced by outliers: 68% (severely inflated)

New: benchmarking splitAt/append/10
time                 987.8 μs   (982.7 μs .. 992.3 μs)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 995.5 μs   (994.6 μs .. 997.2 μs)
std dev              3.845 μs   (1.988 μs .. 6.390 μs)

Old: benchmarking splitAt/append/100
time                 8.028 ms   (8.014 ms .. 8.046 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 8.041 ms   (8.029 ms .. 8.075 ms)
std dev              51.02 μs   (16.07 μs .. 94.69 μs)

New: benchmarking splitAt/append/100
time                 7.382 ms   (7.346 ms .. 7.427 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 7.374 ms   (7.357 ms .. 7.430 ms)
std dev              75.55 μs   (41.64 μs .. 135.4 μs)

Old: benchmarking splitAt/append/1000
time                 15.30 ms   (15.20 ms .. 15.41 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 15.32 ms   (15.26 ms .. 15.45 ms)
std dev              190.0 μs   (89.60 μs .. 351.1 μs)

New: benchmarking splitAt/append/1000
time                 13.68 ms   (13.61 ms .. 13.77 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 13.64 ms   (13.59 ms .. 13.69 ms)
std dev              118.9 μs   (89.45 μs .. 154.4 μs)


index 11c0ca8..a9e481a 100644 (file)
@@ -1080,7 +1080,7 @@ replicateM n x
   | n >= 0      = unwrapMonad (replicateA n (WrapMonad x))
   | otherwise   = error "replicateM takes a nonnegative integer argument"
--- | /O(log(k))/ incremental. @'cycleTaking' k xs@ forms a sequence of length @k@ by
+-- | /O(log(k))/. @'cycleTaking' k xs@ forms a sequence of length @k@ by
 -- repeatedly concatenating @xs@ with itself. @xs@ may only be empty if
 -- @k@ is 0.
@@ -1217,11 +1217,10 @@ appendTree0 (Single x) xs =
 appendTree0 xs (Single x) =
     xs `snocTree` x
 appendTree0 (Deep s1 pr1 m1 sf1) (Deep s2 pr2 m2 sf2) =
-    Deep (s1 + s2) pr1 (addDigits0 m1 sf1 pr2 m2) sf2
+    Deep (s1 + s2) pr1 m sf2
+  where !m = addDigits0 m1 sf1 pr2 m2
-{-# SPECIALIZE addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a)) #-}
-{-# SPECIALIZE addDigits0 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a)) #-}
-addDigits0 :: Sized a => FingerTree (Node a) -> Digit a -> Digit a -> FingerTree (Node a) -> FingerTree (Node a)
+addDigits0 :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Node (Elem a))
 addDigits0 m1 (One a) (One b) m2 =
     appendTree1 m1 (node2 a b) m2
 addDigits0 m1 (One a) (Two b c) m2 =
@@ -1256,16 +1255,17 @@ addDigits0 m1 (Four a b c d) (Four e f g h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
 appendTree1 :: FingerTree (Node a) -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree1 EmptyT a xs =
+appendTree1 EmptyT !a xs =
     a `consTree` xs
-appendTree1 xs a EmptyT =
+appendTree1 xs !a EmptyT =
     xs `snocTree` a
-appendTree1 (Single x) a xs =
+appendTree1 (Single x) !a xs =
     x `consTree` a `consTree` xs
-appendTree1 xs a (Single x) =
+appendTree1 xs !a (Single x) =
     xs `snocTree` a `snocTree` x
 appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) =
-    Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2
+    Deep (s1 + size a + s2) pr1 m sf2
+  where !m = addDigits1 m1 sf1 a pr2 m2
 addDigits1 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
 addDigits1 m1 (One a) b (One c) m2 =
@@ -1302,16 +1302,17 @@ addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
 appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree2 EmptyT b xs =
+appendTree2 EmptyT !a !b xs =
     a `consTree` b `consTree` xs
-appendTree2 xs b EmptyT =
+appendTree2 xs !a !b EmptyT =
     xs `snocTree` a `snocTree` b
 appendTree2 (Single x) a b xs =
     x `consTree` a `consTree` b `consTree` xs
 appendTree2 xs a b (Single x) =
     xs `snocTree` a `snocTree` b `snocTree` x
 appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) =
-    Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2
+    Deep (s1 + size a + size b + s2) pr1 m sf2
+  where !m = addDigits2 m1 sf1 a b pr2 m2
 addDigits2 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
 addDigits2 m1 (One a) b c (One d) m2 =
@@ -1348,19 +1349,20 @@ addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
 appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree3 EmptyT a b c xs =
+appendTree3 EmptyT !a !b !c xs =
     a `consTree` b `consTree` c `consTree` xs
-appendTree3 xs a b c EmptyT =
+appendTree3 xs !a !b !c EmptyT =
     xs `snocTree` a `snocTree` b `snocTree` c
 appendTree3 (Single x) a b c xs =
     x `consTree` a `consTree` b `consTree` c `consTree` xs
 appendTree3 xs a b c (Single x) =
     xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x
 appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) =
-    Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2
+    Deep (s1 + size a + size b + size c + s2) pr1 m sf2
+  where !m = addDigits3 m1 sf1 a b c pr2 m2
 addDigits3 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
-addDigits3 m1 (One a) b c d (One e) m2 =
+addDigits3 m1 (One a) !b !c !d (One e) m2 =
     appendTree2 m1 (node3 a b c) (node2 d e) m2
 addDigits3 m1 (One a) b c d (Two e f) m2 =
     appendTree2 m1 (node3 a b c) (node3 d e f) m2
@@ -1368,7 +1370,7 @@ addDigits3 m1 (One a) b c d (Three e f g) m2 =
     appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
 addDigits3 m1 (One a) b c d (Four e f g h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
-addDigits3 m1 (Two a b) c d e (One f) m2 =
+addDigits3 m1 (Two a b) !c !d !e (One f) m2 =
     appendTree2 m1 (node3 a b c) (node3 d e f) m2
 addDigits3 m1 (Two a b) c d e (Two f g) m2 =
     appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
@@ -1376,7 +1378,7 @@ addDigits3 m1 (Two a b) c d e (Three f g h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits3 m1 (Three a b c) d e f (One g) m2 =
+addDigits3 m1 (Three a b c) !d !e !f (One g) m2 =
     appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
@@ -1384,7 +1386,7 @@ addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits3 m1 (Four a b c d) e f g (One h) m2 =
+addDigits3 m1 (Four a b c d) !e !f !g (One h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
@@ -1394,19 +1396,20 @@ addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
 appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a)
-appendTree4 EmptyT a b c d xs =
+appendTree4 EmptyT !a !b !c !d xs =
     a `consTree` b `consTree` c `consTree` d `consTree` xs
-appendTree4 xs a b c d EmptyT =
+appendTree4 xs !a !b !c !d EmptyT =
     xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d
 appendTree4 (Single x) a b c d xs =
     x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs
 appendTree4 xs a b c d (Single x) =
     xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x
 appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) =
-    Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2
+    Deep (s1 + size a + size b + size c + size d + s2) pr1 m sf2
+  where !m = addDigits4 m1 sf1 a b c d pr2 m2
 addDigits4 :: FingerTree (Node (Node a)) -> Digit (Node a) -> Node a -> Node a -> Node a -> Node a -> Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node (Node a))
-addDigits4 m1 (One a) b c d e (One f) m2 =
+addDigits4 m1 (One a) !b !c !d !e (One f) m2 =
     appendTree2 m1 (node3 a b c) (node3 d e f) m2
 addDigits4 m1 (One a) b c d e (Two f g) m2 =
     appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
@@ -1414,7 +1417,7 @@ addDigits4 m1 (One a) b c d e (Three f g h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Two a b) c d e f (One g) m2 =
+addDigits4 m1 (Two a b) !c !d !e !f (One g) m2 =
     appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2
 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
@@ -1422,7 +1425,7 @@ addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Three a b c) d e f g (One h) m2 =
+addDigits4 m1 (Three a b c) !d !e !f !g (One h) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2
 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
@@ -1430,13 +1433,13 @@ addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-addDigits4 m1 (Four a b c d) e f g h (One i) m2 =
+addDigits4 m1 (Four a b c d) !e !f !g !h (One i) m2 =
     appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2
-addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =
+addDigits4 m1 (Four a b c d) !e !f !g !h (Two i j) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2
-addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =
+addDigits4 m1 (Four a b c d) !e !f !g !h (Three i j k) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2
-addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =
+addDigits4 m1 (Four a b c d) !e !f !g !h (Four i j k l) m2 =
     appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2
 -- | Builds a sequence from a seed value.  Takes time linear in the