From bbfe68867fc9882a8c4e2e419f1bf0fae1f233b2 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 14 Oct 2026 18:28:55 +0530 Subject: [PATCH 1/8] Fix the Show instances of Stream.Nested and StreamK.Nested for nesting The instances defined only show, so the default showsPrec ignored the precedence: show (Just n) produced "Just fromList [1,2]", which the Read instance cannot parse. Delegate showsPrec to the Stream and StreamK instances, which use showParen, the same as the Array fix. Keep show, delegating to an explicit show in the Stream and StreamK instances, the same as the Array instance. --- core/src/Streamly/Internal/Data/Stream/Type.hs | 5 +++++ core/src/Streamly/Internal/Data/StreamK/Type.hs | 5 +++++ test/Streamly/Test/Data/Stream/Type.hs | 13 +++++++++++++ test/Streamly/Test/Data/StreamK.hs | 10 ++++++++++ 4 files changed, 33 insertions(+) diff --git a/core/src/Streamly/Internal/Data/Stream/Type.hs b/core/src/Streamly/Internal/Data/Stream/Type.hs index 5874a564cb..d7a070a06c 100644 --- a/core/src/Streamly/Internal/Data/Stream/Type.hs +++ b/core/src/Streamly/Internal/Data/Stream/Type.hs @@ -1059,6 +1059,8 @@ instance Show a => Show (Stream Identity a) where showsPrec p dl = showParen (p > 10) $ showString "fromList " . shows (GHC.Exts.toList dl) + show dl = "fromList " ++ show (GHC.Exts.toList dl) + instance Read a => Read (Stream Identity a) where readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP @@ -2680,6 +2682,9 @@ deriving instance Ord a => Ord (Nested Identity a) -- Do not use automatic derivation for this to show as "fromList" rather than -- "fromList Identity". instance Show a => Show (Nested Identity a) where + {-# INLINE showsPrec #-} + showsPrec p (Nested xs) = showsPrec p xs + {-# INLINE show #-} show (Nested xs) = show xs diff --git a/core/src/Streamly/Internal/Data/StreamK/Type.hs b/core/src/Streamly/Internal/Data/StreamK/Type.hs index 1f3bf18341..268ba410d6 100644 --- a/core/src/Streamly/Internal/Data/StreamK/Type.hs +++ b/core/src/Streamly/Internal/Data/StreamK/Type.hs @@ -1193,6 +1193,8 @@ instance Show a => Show (StreamK Identity a) where showsPrec p dl = showParen (p > 10) $ showString "fromList " . shows (toList dl) + show dl = "fromList " ++ show (toList dl) + instance Read a => Read (StreamK Identity a) where readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP @@ -2802,6 +2804,9 @@ deriving instance (a ~ Char) => IsString (Nested Identity a) -- Do not use automatic derivation for this to show as "fromList" rather than -- "fromList Identity". instance Show a => Show (Nested Identity a) where + {-# INLINE showsPrec #-} + showsPrec p (Nested xs) = showsPrec p xs + {-# INLINE show #-} show (Nested xs) = show xs diff --git a/test/Streamly/Test/Data/Stream/Type.hs b/test/Streamly/Test/Data/Stream/Type.hs index 6c3d7c74ed..3e909b8e16 100644 --- a/test/Streamly/Test/Data/Stream/Type.hs +++ b/test/Streamly/Test/Data/Stream/Type.hs @@ -9,6 +9,7 @@ module Streamly.Test.Data.Stream.Type (main) where import Control.Exception (ErrorCall(..), catch) +import Data.Functor.Identity (Identity) import Data.IORef (newIORef, readIORef, writeIORef, IORef) import Data.List (sort) import Streamly.Internal.Data.Stream (Stream) @@ -544,6 +545,17 @@ checkFoldrLaziness = do (Stream.fromList (2:4:5:undefined) :: Stream IO Int)) `shouldReturn` [True] +------------------------------------------------------------------------------- +-- Nested +------------------------------------------------------------------------------- + +testNestedShowRead :: Expectation +testNestedShowRead = do + let n = Stream.Nested (Stream.fromList [1, 2]) :: Stream.Nested Identity Int + show (Just n) `shouldBe` "Just (fromList [1,2])" + fmap Stream.unNested (read (show (Just n)) :: Maybe (Stream.Nested Identity Int)) + `shouldBe` Just (Stream.fromList [1, 2]) + moduleName :: String moduleName = "Data.Stream" @@ -747,5 +759,6 @@ main = hspec -} it "concatIterateScan" testConcatIterateScan + it "Nested Show/Read" testNestedShowRead it "refoldIterateM" testRefoldIterateM it "bfsReduceIterate" testBfsReduceIterate diff --git a/test/Streamly/Test/Data/StreamK.hs b/test/Streamly/Test/Data/StreamK.hs index 8ee1e37d08..7ad3324c35 100644 --- a/test/Streamly/Test/Data/StreamK.hs +++ b/test/Streamly/Test/Data/StreamK.hs @@ -8,6 +8,7 @@ module Streamly.Test.Data.StreamK (main) where +import Data.Functor.Identity (Identity, runIdentity) import Data.Word (Word8) import Data.List (sort) import Streamly.Internal.Data.StreamK (StreamK) @@ -74,6 +75,14 @@ sortBy = ) assert $ s1 == s2 +testNestedShowRead :: Expectation +testNestedShowRead = do + let n = StreamK.Nested (StreamK.fromList [1, 2]) :: StreamK.Nested Identity Int + show (Just n) `shouldBe` "Just (fromList [1,2])" + fmap (runIdentity . StreamK.toList . StreamK.unNested) + (read (show (Just n)) :: Maybe (StreamK.Nested Identity Int)) + `shouldBe` Just [1, 2] + moduleName :: String moduleName = "Data.StreamK" @@ -105,3 +114,4 @@ main = hspec (reverse input) [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8] prop "sortBy" sortBy + it "Nested Show/Read" testNestedShowRead From 97edd2e54c54d32fbe0078c0728595ee9a6aa263 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 14 Oct 2026 18:37:24 +0530 Subject: [PATCH 2/8] Combine the first element first in Stream.foldr1 foldr1 used the head of the stream as the seed of a right fold over the tail, so the head was combined last: foldr1 (-) on [1,2,3] computed 2 - (3 - 1) = 0 instead of 1 - (2 - 3) = 2, and foldr1 const returned the second element. The existing tests used only (+). Fold the whole stream with a Maybe accumulator instead. --- core/docs/Changelog.md | 2 ++ core/src/Streamly/Internal/Data/Stream/Eliminate.hs | 11 ++++++----- test/Streamly/Test/Data/Stream/Eliminate.hs | 8 ++++++++ 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index 9a4a4d41dd..0365ce4dc4 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -32,6 +32,8 @@ * Fix `Scanl.uniq` and `uniqBy` failing before the first input. * Fix `Scanl.partition`, `partitionBy` and `partitionByM` not finalizing one scan when the other terminates. +* Fix `Stream.foldr1` combining the first element last, e.g. + `foldr1 (-)` on `[1,2,3]` returned `0` instead of `2`. * On POSIX platforms, the `Path` based APIs that open an existing file in `WriteMode`, e.g. `write` and `withFile` in `Streamly.FileSystem.FileIO`, diff --git a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index 6a665761cb..ffde1be26b 100644 --- a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs @@ -104,11 +104,12 @@ import Streamly.Internal.Data.Stream.Type hiding (splitAt) {-# INLINE_NORMAL foldr1 #-} foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a) -foldr1 f m = do - r <- uncons m - case r of - Nothing -> return Nothing - Just (h, t) -> fmap Just (foldr f h t) +foldr1 f = foldr step Nothing + + where + + step x Nothing = Just x + step x (Just acc) = Just (f x acc) -- | Fold a stream of optional values. -- diff --git a/test/Streamly/Test/Data/Stream/Eliminate.hs b/test/Streamly/Test/Data/Stream/Eliminate.hs index c4baf234a3..0500341330 100644 --- a/test/Streamly/Test/Data/Stream/Eliminate.hs +++ b/test/Streamly/Test/Data/Stream/Eliminate.hs @@ -34,6 +34,13 @@ testFoldr1Single = Stream.foldr1 (+) (Stream.fromList [42 :: Int]) `shouldReturn` Just 42 +testFoldr1NonCommutative :: Expectation +testFoldr1NonCommutative = do + Stream.foldr1 (-) (Stream.fromList [1, 2, 3 :: Int]) + `shouldReturn` Just (foldr1 (-) [1, 2, 3]) + Stream.foldr1 const (Stream.fromList [1, 2, 3 :: Int]) + `shouldReturn` Just 1 + testFoldr1Empty :: Expectation testFoldr1Empty = Stream.foldr1 (+) (Stream.fromList ([] :: [Int])) @@ -263,6 +270,7 @@ main = hspec $ describe moduleName $ do it "foldr1" testFoldr1 it "foldr1 single element" testFoldr1Single it "foldr1 empty" testFoldr1Empty + it "foldr1 non-commutative" testFoldr1NonCommutative describe "Fold Maybes" $ do it "foldMaybes all Just" testFoldMaybesAllJust From 1729a708b855d6a3e02ed374853e8b1fd3dabd13 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 14 Oct 2026 18:37:31 +0530 Subject: [PATCH 3/8] Find an empty infix in any stream in Stream.isInfixOf isInfixOf splits the stream on the infix and checks for a second segment. An empty pattern splits the stream at every element, so a stream of fewer than two elements has fewer than two segments: isInfixOf nil nil and isInfixOf nil (fromList [1]) returned False. An empty infix occurs in every stream; return True for it directly. --- core/docs/Changelog.md | 2 ++ core/src/Streamly/Internal/Data/Stream/Eliminate.hs | 13 ++++++++++--- test/Streamly/Test/Data/Stream/Eliminate.hs | 6 ++++++ 3 files changed, 18 insertions(+), 3 deletions(-) diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index 0365ce4dc4..c454facb52 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -34,6 +34,8 @@ scan when the other terminates. * Fix `Stream.foldr1` combining the first element last, e.g. `foldr1 (-)` on `[1,2,3]` returned `0` instead of `2`. +* Fix `Stream.isInfixOf` returning `False` for an empty infix when the + stream has fewer than two elements. * On POSIX platforms, the `Path` based APIs that open an existing file in `WriteMode`, e.g. `write` and `withFile` in `Streamly.FileSystem.FileIO`, diff --git a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index ffde1be26b..51593663af 100644 --- a/core/src/Streamly/Internal/Data/Stream/Eliminate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs @@ -653,9 +653,16 @@ isInfixOf :: (MonadIO m, Eq a, Enum a, Unbox a) => Stream m a -> Stream m a -> m Bool isInfixOf infx stream = do arr <- fold Array.create infx - -- XXX can use breakOnSeq instead (when available) - r <- null $ StreamD.drop 1 $ Nesting.splitSepBySeq_ arr Fold.drain stream - return (not r) + -- An empty infix occurs in every stream. The split below cannot detect + -- it in a stream of fewer than two elements, which has fewer than two + -- segments. + if Array.length arr == 0 + then return True + else do + -- XXX can use breakOnSeq instead (when available) + r <- null + $ StreamD.drop 1 $ Nesting.splitSepBySeq_ arr Fold.drain stream + return (not r) -- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf -- may use the suffix stream many times. To run in optimal memory we do not diff --git a/test/Streamly/Test/Data/Stream/Eliminate.hs b/test/Streamly/Test/Data/Stream/Eliminate.hs index 0500341330..1408898ad7 100644 --- a/test/Streamly/Test/Data/Stream/Eliminate.hs +++ b/test/Streamly/Test/Data/Stream/Eliminate.hs @@ -168,6 +168,12 @@ testIsInfixOf = do Stream.isInfixOf (Stream.fromList ([] :: [Int])) (Stream.fromList [1, 2, 3]) `shouldReturn` True + Stream.isInfixOf + (Stream.fromList ([] :: [Int])) + (Stream.fromList []) `shouldReturn` True + Stream.isInfixOf + (Stream.fromList ([] :: [Int])) + (Stream.fromList [1]) `shouldReturn` True testIsSuffixOf :: Expectation testIsSuffixOf = do From 7a5cbd30a6696336ee2b9758996f779a05a4bfe2 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 14 Oct 2026 18:37:53 +0530 Subject: [PATCH 4/8] Stop enumerateFromToNum at the last element not beyond the limit enumerateFromToNum yielded x and continued with x + 1 whenever x < to, without checking x + 1 <= to. When to - from is not a whole number the last element exceeded the limit: enumerateFromToNum 1.1 3.2 gave [1.1,2.1,3.1,4.1], and enumerateFromTo (1 :: Rational) (12 % 5), which the Ratio and Fixed Enumerable instances route to enumerateFromToNum, gave [1,2,3] instead of [1,2]. enumerateDownFromToNum had the mirror bug. Fix the Stream functions and the Producer copies used by Unfold. --- core/docs/Changelog.md | 2 ++ core/src/Streamly/Internal/Data/Producer.hs | 14 ++++++++++++-- .../Streamly/Internal/Data/Stream/Enumeration.hs | 14 ++++++++++++-- test/Streamly/Test/Data/Stream/Generate.hs | 13 +++++++++++++ test/Streamly/Test/Data/Unfold.hs | 13 +++++++++++++ 5 files changed, 52 insertions(+), 4 deletions(-) diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index c454facb52..c21d55bac7 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -36,6 +36,8 @@ `foldr1 (-)` on `[1,2,3]` returned `0` instead of `2`. * Fix `Stream.isInfixOf` returning `False` for an empty infix when the stream has fewer than two elements. +* Fix `enumerateFromTo` for `Ratio` and `Fixed` emitting one element beyond + the limit. * On POSIX platforms, the `Path` based APIs that open an existing file in `WriteMode`, e.g. `write` and `withFile` in `Streamly.FileSystem.FileIO`, diff --git a/core/src/Streamly/Internal/Data/Producer.hs b/core/src/Streamly/Internal/Data/Producer.hs index 2a45eff483..e107218649 100644 --- a/core/src/Streamly/Internal/Data/Producer.hs +++ b/core/src/Streamly/Internal/Data/Producer.hs @@ -760,7 +760,13 @@ enumerateFromTo (EnumToInit from to) = enumerateFromTo (EnumToYield from to) = pure $ if to > from - then Yield from (EnumToYield (from + 1) to) + then + -- from + 1 cannot overflow because from < to. For a non-integral + -- gap between from and to, from + 1 can exceed to. + let !next = from + 1 + in if next <= to + then Yield from (EnumToYield next to) + else Yield from EnumToStop -- Note: Usually multiple yields are problematic for fusion, but only -- if we are looping further, for a terminal yield it is in fact better -- to yield here rather than skipping to another state. We used to skip @@ -782,6 +788,10 @@ enumerateDownFromTo (EnumToInit from to) = enumerateDownFromTo (EnumToYield from to) = pure $ if to < from - then Yield from (EnumToYield (from - 1) to) + then + let !next = from - 1 + in if next >= to + then Yield from (EnumToYield next to) + else Yield from EnumToStop else Yield from EnumToStop enumerateDownFromTo EnumToStop = pure Stop diff --git a/core/src/Streamly/Internal/Data/Stream/Enumeration.hs b/core/src/Streamly/Internal/Data/Stream/Enumeration.hs index 7612d73064..454fb0fac3 100644 --- a/core/src/Streamly/Internal/Data/Stream/Enumeration.hs +++ b/core/src/Streamly/Internal/Data/Stream/Enumeration.hs @@ -337,10 +337,16 @@ enumerateFromToNum from to = Stream step EnumToInit if to < from then Stop else Skip $ EnumToYield from + -- x + 1 cannot overflow because x < to. For a non-integral gap between + -- from and to, x + 1 can exceed to, so it is checked before continuing. step _ (EnumToYield x) = pure $ if to > x - then Yield x (EnumToYield (x + 1)) + then + let !nxt = x + 1 + in if nxt <= to + then Yield x (EnumToYield nxt) + else Yield x EnumToStop else Yield x EnumToStop step _ EnumToStop = pure Stop @@ -359,7 +365,11 @@ enumerateDownFromToNum from to = Stream step EnumToInit step _ (EnumToYield x) = pure $ if to < x - then Yield x (EnumToYield (x - 1)) + then + let !nxt = x - 1 + in if nxt >= to + then Yield x (EnumToYield nxt) + else Yield x EnumToStop else Yield x EnumToStop step _ EnumToStop = pure Stop diff --git a/test/Streamly/Test/Data/Stream/Generate.hs b/test/Streamly/Test/Data/Stream/Generate.hs index 956a3d2224..40c283778d 100644 --- a/test/Streamly/Test/Data/Stream/Generate.hs +++ b/test/Streamly/Test/Data/Stream/Generate.hs @@ -14,6 +14,7 @@ import Control.Concurrent (threadDelay) import Data.Functor.Identity (Identity(..)) import Data.IORef (newIORef, readIORef, writeIORef) import Data.Int (Int8, Int64) +import Data.Ratio ((%)) import Data.Word (Word8, Word16) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (withArray) @@ -246,6 +247,17 @@ testEnumerateDownFromToNum = do toList (Stream.enumerateDownFromToNum (2 :: Int) 6) `shouldReturn` [] +-- The last element must not exceed "to" when "to - from" is not a whole +-- number. +testEnumerateFromToNumFractional :: Expectation +testEnumerateFromToNumFractional = do + toList (Stream.enumerateFromToNum (1.1 :: Double) 3.2) + `shouldReturn` [1.1, 2.1, 3.1] + toList (Stream.enumerateDownFromToNum (3.5 :: Double) 1.7) + `shouldReturn` [3.5, 2.5] + toList (Stream.enumerateFromTo (1 :: Rational) (12 % 5)) + `shouldReturn` [1, 2] + testEnumerateDownFromBoundedNum :: Expectation testEnumerateDownFromBoundedNum = do toList (Stream.enumerateDownFromBoundedNum (-124 :: Int8)) @@ -487,6 +499,7 @@ main = hspec $ describe moduleName $ do it "enumerateDownFromThenToNum" testEnumerateFromThenDownToNum it "enumerateDownFromNum" testEnumerateDownFromNum it "enumerateDownFromToNum" testEnumerateDownFromToNum + it "enumerateFromToNum fractional" testEnumerateFromToNumFractional it "enumerateDownFromBoundedNum" testEnumerateDownFromBoundedNum it "enumerateFromThenSmall" testEnumerateFromThenSmall it "enumerateFromToSmall" testEnumerateFromToSmall diff --git a/test/Streamly/Test/Data/Unfold.hs b/test/Streamly/Test/Data/Unfold.hs index f04ca0e4a2..b62b69cba2 100644 --- a/test/Streamly/Test/Data/Unfold.hs +++ b/test/Streamly/Test/Data/Unfold.hs @@ -29,6 +29,7 @@ import Control.Monad.Trans.State.Strict import Data.Functor.Identity import Data.Int (Int8, Int64) import Data.IORef (newIORef, readIORef, writeIORef) +import Data.Ratio ((%)) import Data.Word (Word8) import Foreign.Marshal.Array (withArray) import Prelude hiding (const, take, drop, concat, mapM, either, filter, dropWhile, repeat, scanl) @@ -325,6 +326,17 @@ enumerateDownFromThenToNum = do (Prelude.takeWhile (>= (-1)) [6, 4 ..]) `shouldBe` True +-- The last element must not exceed "to" when "to - from" is not a whole +-- number. +enumerateFromToNumFractional :: Expectation +enumerateFromToNumFractional = do + testUnfold UF.enumerateFromToNum (1.1 :: Double, 3.2) [1.1, 2.1, 3.1] + `shouldBe` True + testUnfold UF.enumerateDownFromToNum (3.5 :: Double, 1.7) [3.5, 2.5] + `shouldBe` True + testUnfold UF.enumerateFromTo (1 :: Rational, 12 % 5) [1, 2] + `shouldBe` True + enumerateDownFromNum :: Property enumerateDownFromNum = property @@ -1286,6 +1298,7 @@ testGeneration = it "enumerateDownFromThenToNum" enumerateDownFromThenToNum prop "enumerateDownFromNum" enumerateDownFromNum prop "enumerateDownFromToNum" enumerateDownFromToNum + it "enumerateFromToNum fractional" enumerateFromToNumFractional it "enumerateDownFromBoundedNum" enumerateDownFromBoundedNum prop "enumerateFromIntegral" enumerateFromIntegral From 3ed7cecec0edbc2629a69e622f6a2eb839b4b82f Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 14 Oct 2026 18:38:05 +0530 Subject: [PATCH 5/8] Enumerate Natural downwards without underflow enumerateFromThenToNum computed the stride as next - from, which throws an arithmetic underflow for Natural when next < from: enumerateFromThenTo (5 :: Natural) 3 0 threw instead of returning [5,3,1]. enumerateFromThen for Natural had the same problem and, being unbounded below, could not stop at 0. For the downward direction use the positive stride from - next and the limit to + stride, stepping by subtraction. For fixed width types this gives the same values modulo 2^n as before, so bounded types are unaffected. Give Natural its own Enumerable instances whose enumerateFromThen stops at 0 when enumerating downwards. Fix the Stream functions and the Producer copy used by Unfold. --- core/docs/Changelog.md | 2 ++ core/src/Streamly/Internal/Data/Producer.hs | 21 +++++++----- .../Internal/Data/Stream/Enumeration.hs | 30 ++++++++++++---- .../Internal/Data/Unfold/Enumeration.hs | 34 ++++++++++++++++++- test/Streamly/Test/Data/Stream/Generate.hs | 14 ++++++++ test/Streamly/Test/Data/Unfold.hs | 15 ++++++++ 6 files changed, 99 insertions(+), 17 deletions(-) diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index c21d55bac7..516311cc8a 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -38,6 +38,8 @@ stream has fewer than two elements. * Fix `enumerateFromTo` for `Ratio` and `Fixed` emitting one element beyond the limit. +* Fix `enumerateFromThen` and `enumerateFromThenTo` for `Natural` failing + with an underflow when enumerating downwards. * On POSIX platforms, the `Path` based APIs that open an existing file in `WriteMode`, e.g. `write` and `withFile` in `Streamly.FileSystem.FileIO`, diff --git a/core/src/Streamly/Internal/Data/Producer.hs b/core/src/Streamly/Internal/Data/Producer.hs index e107218649..d8e668ca5e 100644 --- a/core/src/Streamly/Internal/Data/Producer.hs +++ b/core/src/Streamly/Internal/Data/Producer.hs @@ -633,9 +633,10 @@ enumerateFromStep (x, stride) = -- | State for 'enumerateFromThenToIntegral'. @EnumInit from next to@ is the -- starting state carrying the arguments; it transitions to 'EnumYieldUpward' --- or 'EnumYieldDownward', which carry the current value, the stride and --- @to - stride@ (checked against before incrementing, so that the increment --- itself cannot overflow past the bound). +-- or 'EnumYieldDownward', which carry the current value, the stride and the +-- limit checked before each step, so that the step cannot overflow past the +-- bound. 'EnumYieldUpward' carries @next - from@ and @to - stride@, +-- 'EnumYieldDownward' carries @from - next@ and @to + stride@. ANN_TYPE(EnumState,Fuse) data EnumState a = EnumInit a a a @@ -675,8 +676,10 @@ enumerateFromThenTo (EnumInit from next to) = then Stop else Skip (EnumSingle from) else -- from >= next >= to - let !stride = next - from - in Skip $ EnumYieldDownward from stride (to - stride) + -- Use a positive stride, next - from would underflow for + -- unsigned types like Natural. + let !stride = from - next + in Skip $ EnumYieldDownward from stride (to + stride) enumerateFromThenTo (EnumYieldUpward x stride toMinus) = pure $ if x <= toMinus @@ -684,12 +687,12 @@ enumerateFromThenTo (EnumYieldUpward x stride toMinus) = let !next = x + stride in Yield x $ EnumYieldUpward next stride toMinus else Skip (EnumSingle x) -enumerateFromThenTo (EnumYieldDownward x stride toMinus) = +enumerateFromThenTo (EnumYieldDownward x stride toPlus) = pure $ - if x >= toMinus + if x >= toPlus then - let !next = x + stride - in Yield x $ EnumYieldDownward next stride toMinus + let !next = x - stride + in Yield x $ EnumYieldDownward next stride toPlus else Skip (EnumSingle x) enumerateFromThenTo (EnumSingle x) = pure $ Yield x EnumStop enumerateFromThenTo EnumStop = pure Stop diff --git a/core/src/Streamly/Internal/Data/Stream/Enumeration.hs b/core/src/Streamly/Internal/Data/Stream/Enumeration.hs index 454fb0fac3..0fec936df9 100644 --- a/core/src/Streamly/Internal/Data/Stream/Enumeration.hs +++ b/core/src/Streamly/Internal/Data/Stream/Enumeration.hs @@ -221,8 +221,10 @@ enumerateFromThenToNum from next to = Stream step EnumInit then Stop else Skip (EnumSingle from) else -- from >= next >= to - let !stride = next - from - in Skip $ EnumYieldDownward from stride (to - stride) + -- Use a positive stride, next - from would underflow for + -- unsigned types like Natural. + let !stride = from - next + in Skip $ EnumYieldDownward from stride (to + stride) step _ (EnumYieldUpward x stride toMinus) = pure $ @@ -232,12 +234,12 @@ enumerateFromThenToNum from next to = Stream step EnumInit in Yield x $ EnumYieldUpward nxt stride toMinus else Skip (EnumSingle x) - step _ (EnumYieldDownward x stride toMinus) = + step _ (EnumYieldDownward x stride toPlus) = pure $ - if x >= toMinus + if x >= toPlus then - let !nxt = x + stride - in Yield x $ EnumYieldDownward nxt stride toMinus + let !nxt = x - stride + in Yield x $ EnumYieldDownward nxt stride toPlus else Skip (EnumSingle x) step _ (EnumSingle x) = pure $ Yield x EnumStop @@ -854,7 +856,21 @@ instance (CONSTRAINT) => Enumerable TYPE_NAME where { \ enumerateFromThenTo = enumerateFromThenToNum } ENUMERABLE_UNBOUNDED_NUM(Integer,) -ENUMERABLE_UNBOUNDED_NUM(Natural,) + +-- 'Natural' is bounded below by 0, a downward enumeration stops at 0. +instance Enumerable Natural where + {-# INLINE enumerateFrom #-} + enumerateFrom = enumerateFromNum + {-# INLINE enumerateFromThen #-} + enumerateFromThen from next = + if next >= from + then enumerateFromThenNum from next + else enumerateFromThenToNum from next 0 + {-# INLINE enumerateFromTo #-} + enumerateFromTo = enumerateFromToNum + {-# INLINE enumerateFromThenTo #-} + enumerateFromThenTo = enumerateFromThenToNum + ENUMERABLE_UNBOUNDED_NUM((Fixed a),HasResolution a) ENUMERABLE_UNBOUNDED_NUM((Ratio a),Integral a) diff --git a/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs b/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs index 89054a732d..f1f9c10b4a 100644 --- a/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs +++ b/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs @@ -653,7 +653,39 @@ instance (CONSTRAINT) => Enumerable TYPE_NAME where { \ enumerateFromThenTo = enumerateFromThenToNum } ENUMERABLE_UNBOUNDED_NUM(Integer,) -ENUMERABLE_UNBOUNDED_NUM(Natural,) + +-- 'Natural' is bounded below by 0, a downward enumeration stops at 0. The +-- stride is kept positive because subtracting a larger 'Natural' underflows. +{-# INLINE enumerateFromThenNatural #-} +enumerateFromThenNatural :: Applicative m => Unfold m (Natural, Natural) Natural +enumerateFromThenNatural = Unfold step inject + + where + + inject (from, next) = + pure $ + if next >= from + then Left (from, next - from) + else Right (Just from, from - next) + + step (Left (x, stride)) = pure $ Yield x (Left (x + stride, stride)) + step (Right (Just x, stride)) = + pure $ + if x >= stride + then Yield x (Right (Just (x - stride), stride)) + else Yield x (Right (Nothing, stride)) + step (Right (Nothing, _)) = pure Stop + +instance Enumerable Natural where + {-# INLINE enumerateFrom #-} + enumerateFrom = enumerateFromNum + {-# INLINE enumerateFromThen #-} + enumerateFromThen = enumerateFromThenNatural + {-# INLINE enumerateFromTo #-} + enumerateFromTo = enumerateFromToNum + {-# INLINE enumerateFromThenTo #-} + enumerateFromThenTo = enumerateFromThenToNum + ENUMERABLE_UNBOUNDED_NUM((Fixed a),HasResolution a) ENUMERABLE_UNBOUNDED_NUM((Ratio a),Integral a) diff --git a/test/Streamly/Test/Data/Stream/Generate.hs b/test/Streamly/Test/Data/Stream/Generate.hs index 40c283778d..c48fd71eff 100644 --- a/test/Streamly/Test/Data/Stream/Generate.hs +++ b/test/Streamly/Test/Data/Stream/Generate.hs @@ -20,6 +20,7 @@ import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (withArray) import Foreign.Storable (poke) import GHC.Ptr (Ptr(..)) +import Numeric.Natural (Natural) import System.Mem (performMajorGC) import qualified Streamly.Internal.Data.Stream as Stream @@ -258,6 +259,18 @@ testEnumerateFromToNumFractional = do toList (Stream.enumerateFromTo (1 :: Rational) (12 % 5)) `shouldReturn` [1, 2] +-- Downward enumeration of Natural must not compute "next - from". +testEnumerateNaturalDown :: Expectation +testEnumerateNaturalDown = do + toList (Stream.enumerateFromThenTo (5 :: Natural) 3 0) + `shouldReturn` [5, 3, 1] + toList (Stream.enumerateFromThen (5 :: Natural) 3) + `shouldReturn` [5, 3, 1] + toList (Stream.enumerateFromThen (6 :: Natural) 3) + `shouldReturn` [6, 3, 0] + toList (Stream.take 4 (Stream.enumerateFromThen (1 :: Natural) 3)) + `shouldReturn` [1, 3, 5, 7] + testEnumerateDownFromBoundedNum :: Expectation testEnumerateDownFromBoundedNum = do toList (Stream.enumerateDownFromBoundedNum (-124 :: Int8)) @@ -500,6 +513,7 @@ main = hspec $ describe moduleName $ do it "enumerateDownFromNum" testEnumerateDownFromNum it "enumerateDownFromToNum" testEnumerateDownFromToNum it "enumerateFromToNum fractional" testEnumerateFromToNumFractional + it "enumerateFromThen Natural down" testEnumerateNaturalDown it "enumerateDownFromBoundedNum" testEnumerateDownFromBoundedNum it "enumerateFromThenSmall" testEnumerateFromThenSmall it "enumerateFromToSmall" testEnumerateFromToSmall diff --git a/test/Streamly/Test/Data/Unfold.hs b/test/Streamly/Test/Data/Unfold.hs index b62b69cba2..869055abf8 100644 --- a/test/Streamly/Test/Data/Unfold.hs +++ b/test/Streamly/Test/Data/Unfold.hs @@ -31,6 +31,7 @@ import Data.Int (Int8, Int64) import Data.IORef (newIORef, readIORef, writeIORef) import Data.Ratio ((%)) import Data.Word (Word8) +import Numeric.Natural (Natural) import Foreign.Marshal.Array (withArray) import Prelude hiding (const, take, drop, concat, mapM, either, filter, dropWhile, repeat, scanl) import Test.Hspec as H @@ -337,6 +338,19 @@ enumerateFromToNumFractional = do testUnfold UF.enumerateFromTo (1 :: Rational, 12 % 5) [1, 2] `shouldBe` True +-- Downward enumeration of Natural must not compute "next - from". +enumerateNaturalDown :: Expectation +enumerateNaturalDown = do + testUnfold UF.enumerateFromThenTo (5 :: Natural, 3, 0) [5, 3, 1] + `shouldBe` True + testUnfold UF.enumerateFromThen (5 :: Natural, 3) [5, 3, 1] + `shouldBe` True + testUnfold UF.enumerateFromThen (6 :: Natural, 3) [6, 3, 0] + `shouldBe` True + testUnfold + (UF.take 4 UF.enumerateFromThen) (1 :: Natural, 3) [1, 3, 5, 7] + `shouldBe` True + enumerateDownFromNum :: Property enumerateDownFromNum = property @@ -1299,6 +1313,7 @@ testGeneration = prop "enumerateDownFromNum" enumerateDownFromNum prop "enumerateDownFromToNum" enumerateDownFromToNum it "enumerateFromToNum fractional" enumerateFromToNumFractional + it "enumerateFromThen Natural down" enumerateNaturalDown it "enumerateDownFromBoundedNum" enumerateDownFromBoundedNum prop "enumerateFromIntegral" enumerateFromIntegral From db7e87626e2d164e9dc9ab3747dce389fdd953d8 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Fri, 16 Oct 2026 23:41:12 +0530 Subject: [PATCH 6/8] Enumerate Ratio and Fixed like their Enum instances The Ratio and Fixed Enumerable instances used enumerateFromToNum and enumerateFromThenToNum, which stop at the last element not beyond the limit. Their Enum instances do not: - Ratio rounds the limit to the nearest step, [1 .. 5 % 2] is [1,2,3]. enumerateFromTo and enumerateFromThenTo now keep the elements up to to + stride / 2, using repeated addition since Ratio is exact. - Fixed enumerates the underlying Integer, i.e. in steps of the resolution, [1.5 .. 1.503 :: Milli] is [1.500,1.501,1.502,1.503]. All four methods now map over the Integer instance. enumerateFromToNum and enumerateDownFromToNum (and the Producer copies used by Unfold) checked both to > x and x + 1 <= to on every element. They now compute to - 1 (to + 1 downwards) once at the start and compare x <= to - 1 in the loop, one comparison per element as before the non-integral fix. to - 1 is computed only when from + 1 <= to, so neither to - 1 nor x + 1 overflows for bounded types or underflows for Natural. In the Stream versions the loop compares x <= to - 1 directly, to - 1 is neither a field of the state nor a binding in the closure. A larger state would be allocated on each element of an unfused stream, increasing the allocation of the equations/concatFor (bounded) benchmark by 2.4%. A strict binding would wrap the Stream constructor in a case, a stream used twice then does not fuse with StreamK.fromStream, increasing the allocation of the equations/fairConcatForK (bounded) benchmark by 9.5%. The extra Init branches are duplicated in each copy of the producer, the core size of the equations/unfoldCross (bounded) benchmark grows from about 17.8k to 20.5k terms, 23.6k with GHC 9.14.1, raise its MaxCoreSize from 20000 to 26000. Its run time is unchanged. --- .../Data/Stream/Nesting/LogicUnfold.hs | 2 +- core/docs/Changelog.md | 8 +- core/src/Streamly/Internal/Data/Producer.hs | 58 +++++---- .../Internal/Data/Stream/Enumeration.hs | 110 ++++++++++++++---- .../Internal/Data/Unfold/Enumeration.hs | 50 +++++++- test/Streamly/Test/Data/Stream/Generate.hs | 53 ++++++++- test/Streamly/Test/Data/Unfold.hs | 48 +++++++- 7 files changed, 272 insertions(+), 57 deletions(-) diff --git a/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs index 49daa6b9b6..7dd4716986 100644 --- a/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs +++ b/benchmark/Streamly/Benchmark/Data/Stream/Nesting/LogicUnfold.hs @@ -78,7 +78,7 @@ fairUnfoldSchedEqn maxVal input ints = -- GHC 9.14.1 cannot fuse InterleaveState, though 9.10 can {-# ANN unfoldCrossBounded (PermitTypes [''Int,''Maybe,''InterleaveState]) #-} {-# ANN unfoldCrossBounded (PermitTypeClasses []) #-} -{-# ANN unfoldCrossBounded (MaxCoreSize 20000) #-} +{-# ANN unfoldCrossBounded (MaxCoreSize 26000) #-} {-# NOINLINE unfoldCrossBounded #-} unfoldCrossBounded :: Int -> IO () unfoldCrossBounded maxVal = unfoldCrossEqn maxVal (Type.boundedIntsUnfold maxVal 0) diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index 516311cc8a..88449d2632 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -36,8 +36,12 @@ `foldr1 (-)` on `[1,2,3]` returned `0` instead of `2`. * Fix `Stream.isInfixOf` returning `False` for an empty infix when the stream has fewer than two elements. -* Fix `enumerateFromTo` for `Ratio` and `Fixed` emitting one element beyond - the limit. +* `enumerateFromTo` and `enumerateFromThenTo` for `Ratio` now round the + limit to the nearest step, and `Enumerable` for `Fixed` now steps by the + resolution of the type, the same as their `Enum` instances. +* Fix `enumerateFromToNum` and `enumerateDownFromToNum` emitting one element + beyond the limit when the difference between the limits is not a whole + number. * Fix `enumerateFromThen` and `enumerateFromThenTo` for `Natural` failing with an underflow when enumerating downwards. diff --git a/core/src/Streamly/Internal/Data/Producer.hs b/core/src/Streamly/Internal/Data/Producer.hs index d8e668ca5e..c8128d7cd3 100644 --- a/core/src/Streamly/Internal/Data/Producer.hs +++ b/core/src/Streamly/Internal/Data/Producer.hs @@ -749,27 +749,32 @@ enumerateDownFromThenTo s = fmap (fmap getDown) (enumerateUpFromThenTo s) ANN_TYPE(EnumToState,Fuse) data EnumToState a = EnumToInit a a - | EnumToYield !a a + | EnumToYield !a !a | EnumToStop +-- The loop continues while x <= to - 1, which is the same as x + 1 <= to, so +-- the last element does not exceed "to" even when "to - from" is not a whole +-- number, e.g. for Double, Ratio or Fixed values. A single comparison per +-- element is needed. +-- +-- from + 1 cannot overflow because from < to. to - 1 cannot underflow (e.g. +-- for Natural) because from + 1 <= to. {-# INLINE_LATE enumerateFromTo #-} enumerateFromTo :: (Applicative m, Num a, Ord a) => Producer m (EnumToState a) a enumerateFromTo (EnumToInit from to) = pure $ - if to < from - then Stop - else Skip $ EnumToYield from to -enumerateFromTo (EnumToYield from to) = - pure $ - if to > from - then - -- from + 1 cannot overflow because from < to. For a non-integral - -- gap between from and to, from + 1 can exceed to. + if to <= from + then if to < from then Stop else Yield from EnumToStop + else let !next = from + 1 - in if next <= to - then Yield from (EnumToYield next to) - else Yield from EnumToStop + in if next > to + then Yield from EnumToStop + else Skip $ EnumToYield from (to - 1) +enumerateFromTo (EnumToYield x toMinus) = + pure $ + if x <= toMinus + then Yield x (EnumToYield (x + 1) toMinus) -- Note: Usually multiple yields are problematic for fusion, but only -- if we are looping further, for a terminal yield it is in fact better -- to yield here rather than skipping to another state. We used to skip @@ -777,24 +782,27 @@ enumerateFromTo (EnumToYield from to) = -- benchmark could not fuse, by moving the yield here it fused -- perfectly. It would be nice to investigate the root cause and make a -- guideline from that. - else Yield from EnumToStop + else Yield x EnumToStop enumerateFromTo EnumToStop = pure Stop +-- Mirror of enumerateFromTo, the loop continues while x >= to + 1. to + 1 +-- cannot overflow because to < from. x - 1 cannot underflow (e.g. for +-- Natural) because x >= to + 1. {-# INLINE_LATE enumerateDownFromTo #-} enumerateDownFromTo :: (Applicative m, Num a, Ord a) => Producer m (EnumToState a) a enumerateDownFromTo (EnumToInit from to) = pure $ - if to > from - then Stop - else Skip $ EnumToYield from to -enumerateDownFromTo (EnumToYield from to) = + if to >= from + then if to > from then Stop else Yield from EnumToStop + else + let !toPlus = to + 1 + in if toPlus > from + then Yield from EnumToStop + else Skip $ EnumToYield from toPlus +enumerateDownFromTo (EnumToYield x toPlus) = pure $ - if to < from - then - let !next = from - 1 - in if next >= to - then Yield from (EnumToYield next to) - else Yield from EnumToStop - else Yield from EnumToStop + if x >= toPlus + then Yield x (EnumToYield (x - 1) toPlus) + else Yield x EnumToStop enumerateDownFromTo EnumToStop = pure Stop diff --git a/core/src/Streamly/Internal/Data/Stream/Enumeration.hs b/core/src/Streamly/Internal/Data/Stream/Enumeration.hs index 0fec936df9..0c7b1e51cc 100644 --- a/core/src/Streamly/Internal/Data/Stream/Enumeration.hs +++ b/core/src/Streamly/Internal/Data/Stream/Enumeration.hs @@ -320,6 +320,11 @@ data EnumToState a = -- >>> Stream.toList $ Stream.enumerateFromToNum (254 :: Word8) 255 -- [254,255] -- +-- The last element does not exceed @to@: +-- +-- >>> Stream.toList $ Stream.enumerateFromToNum 1.1 3.2 +-- [1.1,2.1,3.1] +-- -- Equivalent to the following but with better fusion: -- -- >> enumerateUpFromThenToNum from (from + 1) to @@ -333,22 +338,47 @@ enumerateFromToNum from to = Stream step EnumToInit -- Equivalent to the following but with better fusion: -- takeWhile (<= to) $ takeEndBy (== to) $ enumerateFromStepNum from 1 + -- The loop continues while x <= to - 1, which is the same as + -- x + 1 <= to, so the last element does not exceed "to" even when + -- "to - from" is not a whole number, e.g. for Double, Ratio or Fixed + -- values. A single comparison per element is needed. + -- + -- from + 1 cannot overflow because from < to. to - 1 is evaluated only + -- in the EnumToYield state, which is entered only when from + 1 <= to, + -- so it cannot underflow (e.g. for Natural). {-# INLINE_LATE step #-} step _ EnumToInit = pure $ - if to < from - then Stop - else Skip $ EnumToYield from - -- x + 1 cannot overflow because x < to. For a non-integral gap between - -- from and to, x + 1 can exceed to, so it is checked before continuing. + if to <= from + then if to < from then Stop else Yield from EnumToStop + else + let !nxt = from + 1 + in if nxt > to + then Yield from EnumToStop + else Skip $ EnumToYield from + -- (to - 1) in the code below is not stored in the state, so that an + -- unfused stream does not allocate a larger state on each element. It is + -- not a strict binding either, that would wrap the Stream constructor in a + -- case and a stream used twice would then not fuse. + -- + -- A strict binding in the closure, compared in the loop instead of + -- to - 1: + -- + -- > !toMinus = if from + 1 > to then to else to - 1 + -- + -- evaluates and unboxes "to" once, when the stream is created. When "to" + -- is boxed, the fused loop then does not load it on each element, the + -- equations/streamCross (bounded) benchmark takes 1.7 ms instead of + -- 3.1 ms. But a stream bound to a variable and used twice, e.g. as the + -- outer and the inner stream of StreamK.fairConcatFor after + -- StreamK.fromStream, is then shared instead of being inlined at each + -- use, the step function is not inlined and each element allocates a + -- Step, the equations/fairConcatForK (bounded) benchmark allocates 9.5% + -- more. step _ (EnumToYield x) = pure $ - if to > x - then - let !nxt = x + 1 - in if nxt <= to - then Yield x (EnumToYield nxt) - else Yield x EnumToStop + if x <= to - 1 + then Yield x (EnumToYield (x + 1)) else Yield x EnumToStop step _ EnumToStop = pure Stop @@ -358,20 +388,22 @@ enumerateDownFromToNum from to = Stream step EnumToInit where + -- Mirror of enumerateFromToNum, the loop continues while x >= to + 1. + -- to + 1 is evaluated only when to < from, so it cannot overflow. x - 1 + -- cannot underflow (e.g. for Natural) because x >= to + 1. {-# INLINE_LATE step #-} step _ EnumToInit = pure $ - if to > from - then Stop - else Skip $ EnumToYield from + if to >= from + then if to > from then Stop else Yield from EnumToStop + else + if to + 1 > from + then Yield from EnumToStop + else Skip $ EnumToYield from step _ (EnumToYield x) = pure $ - if to < x - then - let !nxt = x - 1 - in if nxt >= to - then Yield x (EnumToYield nxt) - else Yield x EnumToStop + if x >= to + 1 + then Yield x (EnumToYield (x - 1)) else Yield x EnumToStop step _ EnumToStop = pure Stop @@ -871,8 +903,42 @@ instance Enumerable Natural where {-# INLINE enumerateFromThenTo #-} enumerateFromThenTo = enumerateFromThenToNum -ENUMERABLE_UNBOUNDED_NUM((Fixed a),HasResolution a) -ENUMERABLE_UNBOUNDED_NUM((Ratio a),Integral a) +-- Like the 'Enum' instance of 'Fixed', enumerates the underlying 'Integer', +-- i.e. the step is the resolution of the type, not 1. +instance Enumerable (Fixed a) where + {-# INLINE enumerateFrom #-} + enumerateFrom (MkFixed from) = fmap MkFixed $ enumerateFrom from + {-# INLINE enumerateFromThen #-} + enumerateFromThen (MkFixed from) (MkFixed next) = + fmap MkFixed $ enumerateFromThen from next + {-# INLINE enumerateFromTo #-} + enumerateFromTo (MkFixed from) (MkFixed to) = + fmap MkFixed $ enumerateFromTo from to + {-# INLINE enumerateFromThenTo #-} + enumerateFromThenTo (MkFixed from) (MkFixed next) (MkFixed to) = + fmap MkFixed $ enumerateFromThenTo from next to + +-- Like the 'Enum' instance of 'Ratio', the limit is rounded to the nearest +-- step: elements up to @to + stride / 2@ are generated. 'Ratio' arithmetic is +-- exact, so repeated addition is used instead of the numerically stable +-- 'RealFloat' enumeration. +instance Integral a => Enumerable (Ratio a) where + {-# INLINE enumerateFrom #-} + enumerateFrom = enumerateFromNum + {-# INLINE enumerateFromThen #-} + enumerateFromThen = enumerateFromThenNum + {-# INLINE enumerateFromTo #-} + enumerateFromTo from to = + takeWhile (<= to + 1 / 2) $ enumerateFromNum from + {-# INLINE enumerateFromThenTo #-} + enumerateFromThenTo from next to = + takeWhile predicate $ enumerateFromThenNum from next + + where + + mid = (next - from) / 2 + predicate | next >= from = (<= to + mid) + | otherwise = (>= to + mid) #define ENUMERABLE_REAL_FLOAT(FRACTIONAL_TYPE) \ instance Enumerable FRACTIONAL_TYPE where { \ diff --git a/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs b/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs index f1f9c10b4a..4bd8c42672 100644 --- a/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs +++ b/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs @@ -686,8 +686,54 @@ instance Enumerable Natural where {-# INLINE enumerateFromThenTo #-} enumerateFromThenTo = enumerateFromThenToNum -ENUMERABLE_UNBOUNDED_NUM((Fixed a),HasResolution a) -ENUMERABLE_UNBOUNDED_NUM((Ratio a),Integral a) +{-# INLINE unFixed #-} +unFixed :: Fixed a -> Integer +unFixed (MkFixed a) = a + +-- Like the 'Enum' instance of 'Fixed', enumerates the underlying 'Integer', +-- i.e. the step is the resolution of the type, not 1. +instance Enumerable (Fixed a) where + {-# INLINE enumerateFrom #-} + enumerateFrom = map MkFixed $ lmap unFixed enumerateFrom + {-# INLINE enumerateFromThen #-} + enumerateFromThen = + map MkFixed $ lmap (bimap unFixed unFixed) enumerateFromThen + {-# INLINE enumerateFromTo #-} + enumerateFromTo = + map MkFixed $ lmap (bimap unFixed unFixed) enumerateFromTo + {-# INLINE enumerateFromThenTo #-} + enumerateFromThenTo = + map MkFixed + $ lmap + (\(from, next, to) -> (unFixed from, unFixed next, unFixed to)) + enumerateFromThenTo + +-- Like the 'Enum' instance of 'Ratio', the limit is rounded to the nearest +-- step: elements up to @to + stride / 2@ are generated. 'Ratio' arithmetic is +-- exact, so repeated addition is used instead of the numerically stable +-- 'RealFloat' enumeration. +instance Integral a => Enumerable (Ratio a) where + {-# INLINE enumerateFrom #-} + enumerateFrom = enumerateFromNum + {-# INLINE enumerateFromThen #-} + enumerateFromThen = enumerateFromThenNum + {-# INLINE enumerateFromTo #-} + enumerateFromTo = + takeWhileMWithInput (\(_, to) b -> pure $ b <= to + 1 / 2) + $ lmap fst enumerateFromNum + {-# INLINE enumerateFromThenTo #-} + enumerateFromThenTo = + takeWhileMWithInput cond + $ lmap (\(from, next, _) -> (from, next)) enumerateFromThenNum + + where + + cond (from, next, to) b = + let mid = (next - from) / 2 + in pure + $ if next >= from + then b <= to + mid + else b >= to + mid #define ENUMERABLE_REAL_FLOAT(REALFLOAT_TYPE) \ instance Enumerable REALFLOAT_TYPE where { \ diff --git a/test/Streamly/Test/Data/Stream/Generate.hs b/test/Streamly/Test/Data/Stream/Generate.hs index c48fd71eff..bb8442482e 100644 --- a/test/Streamly/Test/Data/Stream/Generate.hs +++ b/test/Streamly/Test/Data/Stream/Generate.hs @@ -11,10 +11,11 @@ module Streamly.Test.Data.Stream.Generate (main) where import Control.Concurrent (threadDelay) +import Data.Fixed (Milli) import Data.Functor.Identity (Identity(..)) import Data.IORef (newIORef, readIORef, writeIORef) import Data.Int (Int8, Int64) -import Data.Ratio ((%)) +import Data.Ratio (Ratio, (%)) import Data.Word (Word8, Word16) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (withArray) @@ -256,8 +257,52 @@ testEnumerateFromToNumFractional = do `shouldReturn` [1.1, 2.1, 3.1] toList (Stream.enumerateDownFromToNum (3.5 :: Double) 1.7) `shouldReturn` [3.5, 2.5] - toList (Stream.enumerateFromTo (1 :: Rational) (12 % 5)) - `shouldReturn` [1, 2] + toList (Stream.enumerateFromToNum (1.5 :: Double) 2) + `shouldReturn` [1.5] + toList (Stream.enumerateDownFromToNum (2 :: Double) 1.5) + `shouldReturn` [2] + +-- The limits must be reached without overflow or underflow. +testEnumerateFromToNumLimits :: Expectation +testEnumerateFromToNumLimits = do + toList (Stream.enumerateFromToNum (maxBound - 1 :: Int8) maxBound) + `shouldReturn` [maxBound - 1, maxBound] + toList (Stream.enumerateFromToNum (maxBound :: Int8) maxBound) + `shouldReturn` [maxBound] + toList (Stream.enumerateDownFromToNum (minBound + 1 :: Int8) minBound) + `shouldReturn` [minBound + 1, minBound] + toList (Stream.enumerateDownFromToNum (minBound :: Int8) minBound) + `shouldReturn` [minBound] + toList (Stream.enumerateFromToNum (0 :: Natural) 2) + `shouldReturn` [0, 1, 2] + toList (Stream.enumerateDownFromToNum (2 :: Natural) 0) + `shouldReturn` [2, 1, 0] + toList (Stream.enumerateFromToNum (0 :: Ratio Natural) (1 % 2)) + `shouldReturn` [0] + toList (Stream.enumerateDownFromToNum (1 % 2 :: Ratio Natural) 0) + `shouldReturn` [1 % 2] + +-- Ratio and Fixed must enumerate like their Enum instances. +testEnumerateRatioFixed :: Expectation +testEnumerateRatioFixed = do + let r = [1, 12 % 5, 5 % 2, 13 % 5, 0, -5 % 2] :: [Rational] + sequence_ + [ toList (Stream.enumerateFromTo a b) `shouldReturn` [a .. b] + | a <- r, b <- r ] + sequence_ + [ toList (Stream.enumerateFromThenTo a b c) `shouldReturn` [a, b .. c] + | a <- r, b <- r, a /= b, c <- r ] + let f = [1.5, 1.503, 1.501, -0.002] :: [Milli] + sequence_ + [ toList (Stream.enumerateFromTo a b) `shouldReturn` [a .. b] + | a <- f, b <- f ] + sequence_ + [ toList (Stream.enumerateFromThenTo a b c) `shouldReturn` [a, b .. c] + | a <- f, b <- f, a /= b, c <- f ] + toList (Stream.take 3 $ Stream.enumerateFrom (1.5 :: Milli)) + `shouldReturn` [1.5, 1.501, 1.502] + toList (Stream.take 3 $ Stream.enumerateFromThen (1.5 :: Milli) 1.498) + `shouldReturn` [1.5, 1.498, 1.496] -- Downward enumeration of Natural must not compute "next - from". testEnumerateNaturalDown :: Expectation @@ -513,6 +558,8 @@ main = hspec $ describe moduleName $ do it "enumerateDownFromNum" testEnumerateDownFromNum it "enumerateDownFromToNum" testEnumerateDownFromToNum it "enumerateFromToNum fractional" testEnumerateFromToNumFractional + it "enumerateFromToNum limits" testEnumerateFromToNumLimits + it "enumerate Ratio and Fixed" testEnumerateRatioFixed it "enumerateFromThen Natural down" testEnumerateNaturalDown it "enumerateDownFromBoundedNum" testEnumerateDownFromBoundedNum it "enumerateFromThenSmall" testEnumerateFromThenSmall diff --git a/test/Streamly/Test/Data/Unfold.hs b/test/Streamly/Test/Data/Unfold.hs index 869055abf8..67904c429a 100644 --- a/test/Streamly/Test/Data/Unfold.hs +++ b/test/Streamly/Test/Data/Unfold.hs @@ -26,10 +26,11 @@ import Streamly.Test.Data.Scanl.Common (evenScanl) import Control.Exception (Exception, SomeException, try) import Control.Monad.Catch (throwM) import Control.Monad.Trans.State.Strict +import Data.Fixed (Milli) import Data.Functor.Identity import Data.Int (Int8, Int64) import Data.IORef (newIORef, readIORef, writeIORef) -import Data.Ratio ((%)) +import Data.Ratio (Ratio, (%)) import Data.Word (Word8) import Numeric.Natural (Natural) import Foreign.Marshal.Array (withArray) @@ -335,7 +336,48 @@ enumerateFromToNumFractional = do `shouldBe` True testUnfold UF.enumerateDownFromToNum (3.5 :: Double, 1.7) [3.5, 2.5] `shouldBe` True - testUnfold UF.enumerateFromTo (1 :: Rational, 12 % 5) [1, 2] + testUnfold UF.enumerateFromToNum (1.5 :: Double, 2) [1.5] + `shouldBe` True + testUnfold UF.enumerateDownFromToNum (2 :: Double, 1.5) [2] + `shouldBe` True + +-- The limits must be reached without overflow or underflow. +enumerateFromToNumLimits :: Expectation +enumerateFromToNumLimits = do + testUnfold UF.enumerateFromToNum + (maxBound - 1 :: Int8, maxBound) [maxBound - 1, maxBound] + `shouldBe` True + testUnfold UF.enumerateFromToNum (maxBound :: Int8, maxBound) [maxBound] + `shouldBe` True + testUnfold UF.enumerateDownFromToNum + (minBound + 1 :: Int8, minBound) [minBound + 1, minBound] + `shouldBe` True + testUnfold UF.enumerateDownFromToNum (minBound :: Int8, minBound) [minBound] + `shouldBe` True + testUnfold UF.enumerateFromToNum (0 :: Ratio Natural, 1 % 2) [0] + `shouldBe` True + testUnfold UF.enumerateDownFromToNum (1 % 2 :: Ratio Natural, 0) [1 % 2] + `shouldBe` True + +-- Ratio and Fixed must enumerate like their Enum instances. +enumerateRatioFixed :: Expectation +enumerateRatioFixed = do + let r = [1, 12 % 5, 5 % 2, 13 % 5, 0, -5 % 2] :: [Rational] + and [ testUnfold UF.enumerateFromTo (a, b) [a .. b] | a <- r, b <- r ] + `shouldBe` True + and [ testUnfold UF.enumerateFromThenTo (a, b, c) [a, b .. c] + | a <- r, b <- r, a /= b, c <- r ] + `shouldBe` True + let f = [1.5, 1.503, 1.501, -0.002] :: [Milli] + and [ testUnfold UF.enumerateFromTo (a, b) [a .. b] | a <- f, b <- f ] + `shouldBe` True + and [ testUnfold UF.enumerateFromThenTo (a, b, c) [a, b .. c] + | a <- f, b <- f, a /= b, c <- f ] + `shouldBe` True + testUnfold (UF.take 3 UF.enumerateFrom) (1.5 :: Milli) [1.5, 1.501, 1.502] + `shouldBe` True + testUnfold (UF.take 3 UF.enumerateFromThen) + (1.5 :: Milli, 1.498) [1.5, 1.498, 1.496] `shouldBe` True -- Downward enumeration of Natural must not compute "next - from". @@ -1313,6 +1355,8 @@ testGeneration = prop "enumerateDownFromNum" enumerateDownFromNum prop "enumerateDownFromToNum" enumerateDownFromToNum it "enumerateFromToNum fractional" enumerateFromToNumFractional + it "enumerateFromToNum limits" enumerateFromToNumLimits + it "enumerate Ratio and Fixed" enumerateRatioFixed it "enumerateFromThen Natural down" enumerateNaturalDown it "enumerateDownFromBoundedNum" enumerateDownFromBoundedNum From b7cf63c5cb46b2809c2167d9ad9427c6d58f7c49 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 14 Oct 2026 18:28:36 +0530 Subject: [PATCH 7/8] Correct the concatEffect, fromFoldableM, unionBy, deleteFirstsBy and insertBy docs The concatEffect note referred to Streamly.Internal.Data.Stream.Nesting.ifThenElse, which does not exist; ifThenElse is defined in Stream.Type. The fromFoldableM doc said it constructs a stream from a Foldable containing pure values, copied from fromFoldable; its input is a Foldable of monadic actions. The documented unionBy definition passed the arguments of deleteFirstsBy in the wrong order, deleting the elements of the second stream from the first stream. For s1 = [1,2,2,4] and s2 = [1,1,2,3,3] it gave [1,2,2,4,2,4] instead of [1,2,2,4,3], which is what unionBy returns. In deleteFirstsBy each element of the second stream deletes one occurrence, so the documented laws did not hold: - deleteFirstsBy (==) (ordNub s2 `append` s1) s2 with s2 = [1,1] and s1 = [1] gives [], not [1]. Without ordNub the law holds for any s2. - deleteFirstsBy (==) (ordNub s2 `interleave` s1) s2 with s2 = [9,8,7,1] and s1 = [1,2] gives [2,1], not [1,2], because the 1 from s1 comes first in the interleaved stream and is deleted. Keep the append law without ordNub and drop the interleave law. The implementation buffers the second stream, not the first, so the space is O(n) in the second stream. The insertBy docs said the element is inserted before the first element that is less than it. insertBy inserts it before the first element x with cmp elem x /= GT, i.e. the first element greater than or equal to it, and the doc example insertBy compare 2 [1,3,5] = [1,2,3,5] shows that. --- core/src/Streamly/Internal/Data/Stream/Generate.hs | 3 ++- core/src/Streamly/Internal/Data/Stream/Top.hs | 7 +++---- core/src/Streamly/Internal/Data/Stream/Transform.hs | 5 +++-- core/src/Streamly/Internal/Data/Stream/Type.hs | 3 +-- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/core/src/Streamly/Internal/Data/Stream/Generate.hs b/core/src/Streamly/Internal/Data/Stream/Generate.hs index a48876f97b..673e162ab5 100644 --- a/core/src/Streamly/Internal/Data/Stream/Generate.hs +++ b/core/src/Streamly/Internal/Data/Stream/Generate.hs @@ -542,7 +542,8 @@ fromFoldable = Prelude.foldr cons nil -- | -- >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil -- --- Construct a stream from a 'Foldable' containing pure values: +-- Construct a stream from a 'Foldable' containing monadic actions. The +-- actions are run in order when the stream is evaluated: -- -- /WARNING: O(n^2), suitable only for a small number of -- elements in the stream/ diff --git a/core/src/Streamly/Internal/Data/Stream/Top.hs b/core/src/Streamly/Internal/Data/Stream/Top.hs index 65499051e8..597d469bc8 100644 --- a/core/src/Streamly/Internal/Data/Stream/Top.hs +++ b/core/src/Streamly/Internal/Data/Stream/Top.hs @@ -337,12 +337,11 @@ sortedIntersectBy cmp (Stream stepa ta) (Stream stepb tb) = -- -- The following holds: -- --- > deleteFirstsBy (==) (Stream.ordNub s2 `append` s1) s2 === s1 --- > deleteFirstsBy (==) (Stream.ordNub s2 `interleave` s1) s2 === s1 +-- > deleteFirstsBy (==) (s2 `append` s1) s2 === s1 -- -- First stream can be infinite, second stream must be finite. -- --- Space: O(m) where @m@ is the number of elements in the first stream. +-- Space: O(n) where @n@ is the number of elements in the second stream. -- -- Time: O(m x n) where @m@ is the number of elements in the first stream and -- @n@ is the number of elements in the second stream. @@ -399,7 +398,7 @@ sortedDeleteFirstsBy _eq _s1 _s2 = undefined -- -- Equivalent to the following except that @s2@ is evaluated only once: -- --- >>> unionBy eq s1 s2 = s1 `Stream.append` Stream.deleteFirstsBy eq s1 (Stream.ordNub s2) +-- >>> unionBy eq s1 s2 = s1 `Stream.append` Stream.deleteFirstsBy eq (Stream.ordNub s2) s1 -- -- Example: -- diff --git a/core/src/Streamly/Internal/Data/Stream/Transform.hs b/core/src/Streamly/Internal/Data/Stream/Transform.hs index f9b2e4d721..641c1f64b7 100644 --- a/core/src/Streamly/Internal/Data/Stream/Transform.hs +++ b/core/src/Streamly/Internal/Data/Stream/Transform.hs @@ -1507,8 +1507,9 @@ dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m -- Inserting Elements ------------------------------------------------------------------------------ --- | @insertBy cmp elem stream@ inserts @elem@ before the first element in --- @stream@ that is less than @elem@ when compared using @cmp@. +-- | @insertBy cmp elem stream@ inserts @elem@ before the first element @x@ in +-- @stream@ that is greater than or equal to @elem@, i.e. @cmp elem x /= GT@. +-- If there is no such element, @elem@ is appended at the end. -- -- >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x) -- diff --git a/core/src/Streamly/Internal/Data/Stream/Type.hs b/core/src/Streamly/Internal/Data/Stream/Type.hs index d7a070a06c..bc5b24f049 100644 --- a/core/src/Streamly/Internal/Data/Stream/Type.hs +++ b/core/src/Streamly/Internal/Data/Stream/Type.hs @@ -1875,8 +1875,7 @@ concat = concatMap id -- Note: When the stream being generated is composed of statically known -- streams, prefer composing them using a fused operation instead of -- 'concatEffect', as fusion avoids the overhead of going through the --- stream-of-streams machinery. For example, prefer --- 'Streamly.Internal.Data.Stream.Nesting.ifThenElse' over using +-- stream-of-streams machinery. For example, prefer 'ifThenElse' over using -- 'concatEffect' to compose two statically known streams based on a monadic -- predicate. -- From b83929c7aa1f23cc908b509a5d821875e08a7c91 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Fri, 16 Oct 2026 17:10:16 +0530 Subject: [PATCH 8/8] Add INLINE pragmas to modifyIndex and unsafeModifyIndex Without INLINE, modifyIndex was called through the Unbox dictionary and boxed its result. In a BFS over a graph of 10^6 nodes using a MutArray Bool visited bitmap, inlining it reduced the time from 270-290 ms to about 100 ms and the allocation about 9 times. --- core/src/Streamly/Internal/Data/MutArray/Type.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/core/src/Streamly/Internal/Data/MutArray/Type.hs b/core/src/Streamly/Internal/Data/MutArray/Type.hs index 86770cd453..c8f7b6112d 100644 --- a/core/src/Streamly/Internal/Data/MutArray/Type.hs +++ b/core/src/Streamly/Internal/Data/MutArray/Type.hs @@ -953,6 +953,7 @@ putIndices arr = FL.foldlM' step (return ()) -- Unsafe because it does not check the bounds of the array. -- -- /Pre-release/ +{-# INLINE unsafeModifyIndex #-} modifyIndexUnsafe, unsafeModifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b unsafeModifyIndex i MutArray{..} f = liftIO $ do @@ -966,6 +967,7 @@ unsafeModifyIndex i MutArray{..} f = liftIO $ do -- | Modify a given index of an array using a modifier function. -- -- /Pre-release/ +{-# INLINE modifyIndex #-} modifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b modifyIndex i MutArray{..} f = do