@@ -1055,39 +1055,55 @@ concatPairsWith
10551055 -> (a -> Stream m b)
10561056 -> Stream m a
10571057 -> Stream m b
1058−concatPairsWith combine f = go Nothing
1058+concatPairsWith combine f str = go (leafPairs str)
10591059
10601060 where
10611061
1062− go Nothing stream =
1062+ go stream =
10631063 mkStream $ \st yld sng stp ->
10641064 let foldShared = foldStreamShared st yld sng stp
1065− single a = foldShared $ unShare (f a)
1066− yieldk a r = foldShared $ go (Just a) r
1065+ single a = foldShared $ unShare a
1066+ yieldk a r = foldShared $ go1 a r
10671067 in foldStream (adaptState st) yieldk single stp stream
1068− go (Just a1) stream =
1068+
1069+ go1 a1 stream =
10691070 mkStream $ \st yld sng stp ->
10701071 let foldShared = foldStreamShared st yld sng stp
1071− stop = foldShared $ unShare (f a1)
1072− single a = foldShared $ unShare (f a1) `combine` f a
1072+ stop = foldShared $ unShare a1
1073+ single a = foldShared $ unShare a1 `combine` a
10731074 yieldk a r =
1074− foldShared
1075− $ concatPairsWith combine
1076− (\(x,y) -> combine (unShare x) y)
1077− $ (f a1, f a) `cons` makePairs Nothing r
1075+ foldShared $ go $ combine a1 a `cons` nonLeafPairs r
10781076 in foldStream (adaptState st) yieldk single stop stream
10791077
1080− makePairs Nothing stream =
1078+ -- Exactly the same as "go" except that stop continuation extracts the
1079+ -- stream.
1080+ leafPairs stream =
10811081 mkStream $ \st yld sng stp ->
10821082 let foldShared = foldStreamShared st yld sng stp
1083− single a = sng (f a, nil)
1084− yieldk a r = foldShared $ makePairs (Just a) r
1083+ single a = sng (f a)
1084+ yieldk a r = foldShared $ leafPairs1 a r
10851085 in foldStream (adaptState st) yieldk single stp stream
1086− makePairs (Just a1) stream =
1086+
1087+ leafPairs1 a1 stream =
1088+ mkStream $ \st yld sng _ ->
1089+ let stop = sng (f a1)
1090+ single a = sng (f a1 `combine` f a)
1091+ yieldk a r = yld (f a1 `combine` f a) $ leafPairs r
1092+ in foldStream (adaptState st) yieldk single stop stream
1093+
1094+ -- Exactly the same as "leafPairs" except that it does not map "f"
1095+ nonLeafPairs stream =
1096+ mkStream $ \st yld sng stp ->
1097+ let foldShared = foldStreamShared st yld sng stp
1098+ single a = sng a
1099+ yieldk a r = foldShared $ nonLeafPairs1 a r
1100+ in foldStream (adaptState st) yieldk single stp stream
1101+
1102+ nonLeafPairs1 a1 stream =
10871103 mkStream $ \st yld sng _ ->
1088− let stop = sng (f a1, nil)
1089− single a = sng (f a1, f a)
1090− yieldk a r = yld (f a1, f a) (makePairs Nothing r)
1104+ let stop = sng a1
1105+ single a = sng (a1 `combine` a)
1106+ yieldk a r = yld (a1 `combine` a) $ nonLeafPairs r
10911107 in foldStream (adaptState st) yieldk single stop stream
10921108
10931109instance Monad m => Applicative (Stream m) where