@@ -1202,38 +1202,38 @@ many (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =
1202 -- Caution! There is mutual recursion here, inlining the right functions is
1202 -- Caution! There is mutual recursion here, inlining the right functions is
1203 -- important.
1203 -- important.
1205− {-# INLINE handleSplitStep #-}
1205+ {-# INLINE split #-}
1206− handleSplitStep branch cs sres =
1206+ split f cs sres =
1207 case sres of
1207 case sres of
1208− Partial ss1 -> return $ Partial $ branch ss1 cs
1208+ Partial ss -> return $ Partial $ f ss cs
1209− Done sb -> runCollector ManyFirst cs sb
1209+ Done sb -> cstep cs sb >>= collect
1211− {-# INLINE handleCollectStep #-}
1211+ {-# INLINE collect #-}
1212− handleCollectStep branch cres =
1212+ collect cres =
1213 case cres of
1213 case cres of
1214− Partial cs -> do
1214+ Partial cs -> sinitial >>= split ManyFirst cs
1216− handleSplitStep branch cs sres
1217 Done cb -> return $ Done cb
1215 Done cb -> return $ Done cb
1219− -- Do not inline this
1217+ -- A fold may terminate even without accepting a single input. So we run
1220− runCollector branch cs sb = cstep cs sb >>= handleCollectStep branch
1218+ -- the split fold's initial action even if no input is received. However,
1221−
1219+ -- this means that if no input was ever received by "step" we discard the
1220+ -- fold's initial result which could have generated an effect. However,
1221+ -- note that if "sinitial" results in Done we do collect its output even
1222+ -- though the fold may not have received any input. XXX Is this
1222− initial = cinitial >>= handleCollectStep ManyFirst
1224+ initial = cinitial >>= collect
1224 {-# INLINE step_ #-}
1226 {-# INLINE step_ #-}
1225− step_ ss cs a = do
1227+ step_ ss cs a = sstep ss a >>= split ManyLoop cs
1227− handleSplitStep ManyLoop cs sres
1229 {-# INLINE step #-}
1229 {-# INLINE step #-}
1230 step (ManyFirst ss cs) a = step_ ss cs a
1230 step (ManyFirst ss cs) a = step_ ss cs a
1231 step (ManyLoop ss cs) a = step_ ss cs a
1231 step (ManyLoop ss cs) a = step_ ss cs a
1233+ -- Do not extract the split fold if no item was consumed.
1233 extract (ManyFirst _ cs) = cextract cs
1234 extract (ManyFirst _ cs) = cextract cs
1234 extract (ManyLoop ss cs) = do
1235 extract (ManyLoop ss cs) = do
1235− sb <- sextract ss
1236+ cres <- sextract ss >>= cstep cs
1236− cres <- cstep cs sb
1237 case cres of
1237 case cres of
1238 Partial s -> cextract s
1238 Partial s -> cextract s
1239 Done b -> return b
1239 Done b -> return b
@@ -1262,33 +1262,25 @@ manyPost (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =
1262 -- Caution! There is mutual recursion here, inlining the right functions is
1262 -- Caution! There is mutual recursion here, inlining the right functions is
1263 -- important.
1263 -- important.
1265− {-# INLINE handleSplitStep #-}
1265+ {-# INLINE split #-}
1266− handleSplitStep cs sres =
1266+ split cs sres =
1267 case sres of
1267 case sres of
1268 Partial ss1 -> return $ Partial $ Tuple' ss1 cs
1268 Partial ss1 -> return $ Partial $ Tuple' ss1 cs
1269− Done sb -> runCollector cs sb
1269+ Done sb -> cstep cs sb >>= collect
1271− {-# INLINE handleCollectStep #-}
1271+ {-# INLINE collect #-}
1272− handleCollectStep cres =
1272+ collect cres =
1273 case cres of
1273 case cres of
1274− Partial cs -> do
1274+ Partial cs -> sinitial >>= split cs
1276− handleSplitStep cs sres
1277 Done cb -> return $ Done cb
1275 Done cb -> return $ Done cb
1279− -- Do not inline this
1280− runCollector cs sb = cstep cs sb >>= handleCollectStep
1282− initial = cinitial >>= handleCollectStep
1277+ initial = cinitial >>= collect
1284 {-# INLINE step #-}
1279 {-# INLINE step #-}
1285− step (Tuple' ss cs) a = do
1280+ step (Tuple' ss cs) a = sstep ss a >>= split cs
1287− handleSplitStep cs sres
1289 extract (Tuple' ss cs) = do
1282 extract (Tuple' ss cs) = do
1290− sb <- sextract ss
1283+ cres <- sextract ss >>= cstep cs
1291− cres <- cstep cs sb
1292 case cres of
1284 case cres of
1293 Partial s -> cextract s
1285 Partial s -> cextract s
1294 Done b -> return b
1286 Done b -> return b