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 9a4a4d41dd..88449d2632 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -32,6 +32,18 @@ * 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`. +* Fix `Stream.isInfixOf` returning `False` for an empty infix when the + stream has fewer than two elements. +* `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. * 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/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 diff --git a/core/src/Streamly/Internal/Data/Producer.hs b/core/src/Streamly/Internal/Data/Producer.hs index 2a45eff483..c8128d7cd3 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 @@ -746,21 +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) = + 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 EnumToStop + else Skip $ EnumToYield from (to - 1) +enumerateFromTo (EnumToYield x toMinus) = pure $ - if to > from - then Yield from (EnumToYield (from + 1) to) + 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 @@ -768,20 +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 Yield from (EnumToYield (from - 1) to) - 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/Eliminate.hs b/core/src/Streamly/Internal/Data/Stream/Eliminate.hs index 6a665761cb..51593663af 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. -- @@ -652,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/core/src/Streamly/Internal/Data/Stream/Enumeration.hs b/core/src/Streamly/Internal/Data/Stream/Enumeration.hs index 7612d73064..0c7b1e51cc 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 @@ -318,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 @@ -331,15 +338,46 @@ 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 + 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 + if x <= to - 1 then Yield x (EnumToYield (x + 1)) else Yield x EnumToStop step _ EnumToStop = pure Stop @@ -350,15 +388,21 @@ 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 + if x >= to + 1 then Yield x (EnumToYield (x - 1)) else Yield x EnumToStop step _ EnumToStop = pure Stop @@ -844,9 +888,57 @@ instance (CONSTRAINT) => Enumerable TYPE_NAME where { \ enumerateFromThenTo = enumerateFromThenToNum } ENUMERABLE_UNBOUNDED_NUM(Integer,) -ENUMERABLE_UNBOUNDED_NUM(Natural,) -ENUMERABLE_UNBOUNDED_NUM((Fixed a),HasResolution a) -ENUMERABLE_UNBOUNDED_NUM((Ratio a),Integral a) + +-- '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 + +-- 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/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 5874a564cb..bc5b24f049 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 @@ -1873,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. -- @@ -2680,6 +2681,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/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs b/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs index 89054a732d..4bd8c42672 100644 --- a/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs +++ b/core/src/Streamly/Internal/Data/Unfold/Enumeration.hs @@ -653,9 +653,87 @@ instance (CONSTRAINT) => Enumerable TYPE_NAME where { \ enumerateFromThenTo = enumerateFromThenToNum } ENUMERABLE_UNBOUNDED_NUM(Integer,) -ENUMERABLE_UNBOUNDED_NUM(Natural,) -ENUMERABLE_UNBOUNDED_NUM((Fixed a),HasResolution a) -ENUMERABLE_UNBOUNDED_NUM((Ratio a),Integral a) + +-- '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 + +{-# 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/Eliminate.hs b/test/Streamly/Test/Data/Stream/Eliminate.hs index c4baf234a3..1408898ad7 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])) @@ -161,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 @@ -263,6 +276,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 diff --git a/test/Streamly/Test/Data/Stream/Generate.hs b/test/Streamly/Test/Data/Stream/Generate.hs index 956a3d2224..bb8442482e 100644 --- a/test/Streamly/Test/Data/Stream/Generate.hs +++ b/test/Streamly/Test/Data/Stream/Generate.hs @@ -11,14 +11,17 @@ 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 (Ratio, (%)) import Data.Word (Word8, Word16) 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 @@ -246,6 +249,73 @@ 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.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 +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)) @@ -487,6 +557,10 @@ main = hspec $ describe moduleName $ do it "enumerateDownFromThenToNum" testEnumerateFromThenDownToNum 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 it "enumerateFromToSmall" testEnumerateFromToSmall 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 diff --git a/test/Streamly/Test/Data/Unfold.hs b/test/Streamly/Test/Data/Unfold.hs index f04ca0e4a2..67904c429a 100644 --- a/test/Streamly/Test/Data/Unfold.hs +++ b/test/Streamly/Test/Data/Unfold.hs @@ -26,10 +26,13 @@ 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 (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 @@ -325,6 +328,71 @@ 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.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". +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 @@ -1286,6 +1354,10 @@ testGeneration = it "enumerateDownFromThenToNum" enumerateDownFromThenToNum 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 prop "enumerateFromIntegral" enumerateFromIntegral