infinite-list (empty) → 0.1
raw patch · 10 files changed
+2460/−0 lines, 10 filesdep +QuickCheckdep +basedep +ghc-prim
Dependencies added: QuickCheck, base, ghc-prim, infinite-list, tasty, tasty-bench, tasty-expected-failure, tasty-inspection-testing, tasty-quickcheck
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- README.md +66/−0
- bench/Bench.hs +11/−0
- infinite-list.cabal +93/−0
- src/Data/List/Infinite.hs +1099/−0
- src/Data/List/Infinite/Internal.hs +18/−0
- src/Data/List/Infinite/Zip.hs +336/−0
- test/Fusion.hs +332/−0
- test/Properties.hs +472/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1++* Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2022, Bodigrim++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Bodigrim nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,66 @@+# infinite-list++Modern lightweight library for infinite lists with fusion:++* API similar to `Data.List`.+* No non-boot dependencies.+* Top performance, driven by fusion.+* Avoid dangerous instances like `Foldable`.+* Use `NonEmpty` where applicable.+* Use `Word` for indices.+* Be lazy, but not too lazy.++```haskell+{-# LANGUAGE PostfixOperators #-}+import Data.List.Infinite (Infinite(..), (...), (....))+import qualified Data.List.Infinite as Inf+```++## Prior art and inspiration++* [`Data.Stream.Infinite`](https://hackage.haskell.org/package/streams/docs/Data-Stream-Infinite.html) from [`streams`](https://hackage.haskell.org/package/streams) package:+ * Large dependency footprint, e. g., `adjunctions`.+ * Provides dangerous instances such as `Foldable`.+ * No fusion framework.++* [`Data.Stream`](https://hackage.haskell.org/package/Stream/docs/Data-Stream.html) from [`Stream`](https://hackage.haskell.org/package/Stream) package:+ * No fusion framework.+ * No repository or issue tracker.++* [`GHC.Data.List.Infinite`](https://gitlab.haskell.org/ghc/ghc/-/blob/080fffa1015bcc0cff8ab4ad1eeb507fb7a13383/compiler/GHC/Data/List/Infinite.hs) in GHC source tree:+ * Limited API, only to cater for GHC internals.+ * Not available as a separate package outside of GHC.++## Why no `Foldable` or `Traversable`?++The breakdown of members of `Foldable` is as follows:++* `foldr`, `foldr1`, `foldMap`, `fold`, `toList` and `null` can be productive on infinite lists;+* `foldr'`, `foldMap'` cannot, because forcing an accumulator even to a WHNF makes fold non-terminating;+* `foldl`, `foldl'`, `foldl1` cannot, because no left fold can;+* `length` always diverges;+* `elem` either returns `True`, or does not terminate, but never returns `False`;+* `maximum`, `minimum`, `sum` and `product` are unlikely to be productive, unless an underlying `instance Ord` or `instance Num` is extremely lazy.++Altogether it means that code, polymorphic by `Foldable`, cannot confidently work with infinite lists. Even a trivial refactoring can get you in a deep trouble. It's better to save users from this pitfall and do not provide `instance Foldable` at all. We do provide a right fold however.++Since there is no `Foldable`, there could be no `Traversable`. Even if it was not prohibited because of a missing superclass, there are only a few monads, which are lazy enough to be productive for infinite traversals. If you are looking for a traverse with a lazy state, use `mapAccumL`.++## Laziness++Operations, returning a data type with a single constructor, can be implemented in an extremely lazy fashion. Namely, always return the constructor before inspecting any of the arguments. For instance, note the irrefutable pattern matching in `Data.List.NonEmpty`:++```haskell+map :: (a -> b) -> NonEmpty a -> NonEmpty b+map f ~(a :| as) = f a :| fmap f as+```++Because of it forcing the result to WHNF does not force any of the arguments, e. g., ``Data.List.NonEmpty.map undefined undefined `seq` 1`` returns `1`. This is not the case for normal lists: since there are two constructors, `map` has to inspect the argument before returning anything, and ``Data.List.map undefined undefined `seq` 1`` throws an error.++While `Data.List.Infinite` has a single constructor, we believe that following the example of `Data.List.NonEmpty` is harmful for the majority of applications. Instead the laziness of the API is modeled on the laziness of respective operations on `Data.List`: a function `Data.List.Infinite.foo` operating over `Infinite a` is expected to have the same strictness properties as `Data.List.foo` operating over `[a]`. For instance, ``Data.List.Infinite.map undefined undefined `seq` 1`` diverges.++## Indexing++Most of historical APIs (such as `Data.List`) use `Int` to index elements of containers. This library makes another choice: namely, indices are represented by an unsigned type, `Word`. This way the notorious partial function `(!!) :: [a] -> Int -> a` becomes a total `(!!) :: Infinite a -> Word -> a`.++An argument can be made to use an arbitrary-precision type `Natural` instead of finite `Word`. Unfortunately, this causes performance penalties since `Natural` is represented by a heap object and cannot be easily unboxed. On any GHC-supported architecture the addressable memory is less than `maxBound :: Word` bytes and thus it's impossible to materialize a container with more than `maxBound :: Word` elements.
+ bench/Bench.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE PostfixOperators #-}++module Main where++-- import qualified Data.List.Infinite as Inf+import Test.Tasty.Bench++main :: IO ()+main = defaultMain+ [+ ]
+ infinite-list.cabal view
@@ -0,0 +1,93 @@+cabal-version: 1.18+name: infinite-list+version: 0.1+license: BSD3+license-file: LICENSE+maintainer: andrew.lelechenko@gmail.com+author: Bodigrim+tested-with:+ ghc ==8.0.2 ghc ==8.2.2 ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.4+ ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.5 ghc ==9.4.3++homepage: https://github.com/Bodigrim/infinite-list+synopsis: Infinite lists+description:+ Modern lightweight library for infinite lists with fusion:+ .+ * API similar to "Data.List".+ * No non-boot dependencies.+ * Top performance, driven by fusion.+ * Avoid dangerous instances like `Foldable`.+ * Use `NonEmpty` where applicable.+ * Use `Word` for indices.+ * Be lazy, but not too lazy.+ .+ @+ {\-# LANGUAGE PostfixOperators #-\}+ import Data.List.Infinite (Infinite(..), (...), (....))+ import qualified Data.List.Infinite as Inf+ @++category: Data+build-type: Simple+extra-doc-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/Bodigrim/infinite-list++library+ exposed-modules: Data.List.Infinite+ hs-source-dirs: src+ other-modules:+ Data.List.Infinite.Zip+ Data.List.Infinite.Internal++ default-language: Haskell2010+ ghc-options: -Wall+ build-depends: base >=4.9 && <5++ if impl(ghc <8.2)+ build-depends: ghc-prim++test-suite infinite-properties+ type: exitcode-stdio-1.0+ main-is: Properties.hs+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base,+ infinite-list,+ QuickCheck,+ tasty,+ tasty-quickcheck++test-suite infinite-fusion+ type: exitcode-stdio-1.0+ main-is: Fusion.hs+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base,+ infinite-list,+ tasty,+ tasty-inspection-testing,+ tasty-expected-failure++ if impl(ghc <9.2)+ buildable: False++benchmark infinite-bench+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base,+ infinite-list,+ tasty-bench
+ src/Data/List/Infinite.hs view
@@ -0,0 +1,1099 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}++{-# HLINT ignore "Redundant lambda" #-}++-- |+-- Copyright: (c) 2022 Bodigrim+-- License: BSD3+--+-- Modern lightweight library for infinite lists with fusion:+--+-- * API similar to "Data.List".+-- * No non-boot dependencies.+-- * Top performance, driven by fusion.+-- * Avoid dangerous instances like `Data.Foldable.Foldable`.+-- * Use `NonEmpty` where applicable.+-- * Use `Word` for indices.+-- * Be lazy, but not too lazy.+--+-- @+-- {\-# LANGUAGE PostfixOperators #-\}+-- import Data.List.Infinite (Infinite(..), (...), (....))+-- import qualified Data.List.Infinite as Inf+-- @+module Data.List.Infinite (+ -- * Construction+ Infinite (..),++ -- * Elimination+ head,+ tail,+ uncons,+ toList,+ foldr,++ -- * Traversals+ map,+ scanl,+ scanl',+ scanl1,+ mapAccumL,++ -- * Transformations+ concat,+ concatMap,+ intersperse,+ intercalate,+ interleave,+ transpose,+ subsequences,+ subsequences1,+ permutations,++ -- * Building+ (...),+ (....),+ iterate,+ iterate',+ unfoldr,+ tabulate,+ repeat,+ cycle,++ -- * Sublists+ prependList,+ take,+ drop,+ splitAt,+ takeWhile,+ dropWhile,+ span,+ break,+ group,+ inits,+ inits1,+ tails,+ isPrefixOf,+ stripPrefix,++ -- * Searching+ lookup,+ find,+ filter,+ partition,++ -- * Indexing+ (!!),+ elemIndex,+ elemIndices,+ findIndex,+ findIndices,++ -- * Zipping+ zip,+ zipWith,+ zip3,+ zipWith3,+ zip4,+ zipWith4,+ zip5,+ zipWith5,+ zip6,+ zipWith6,+ zip7,+ zipWith7,+ unzip,+ unzip3,+ unzip4,+ unzip5,+ unzip6,+ unzip7,++ -- * Functions on strings+ lines,+ words,+ unlines,+ unwords,++ -- * Set operations+ nub,+ delete,+ (\\),+ union,+ intersect,++ -- * Ordered lists+ insert,++ -- * Generalized functions+ nubBy,+ deleteBy,+ deleteFirstsBy,+ unionBy,+ intersectBy,+ groupBy,+ insertBy,+ genericTake,+ genericDrop,+ genericSplitAt,+) where++import Control.Applicative (Applicative (..))+import Control.Arrow (first, second)+import Control.Monad (Monad (..))+import Data.Bits ((.&.))+import Data.Char (Char, isSpace)+import Data.Coerce (coerce)+import Data.Eq (Eq, (/=), (==))+import qualified Data.Foldable as F+import Data.Functor (Functor (..))+import qualified Data.List as List+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Ord (Ord, Ordering (..), compare, (<), (<=), (>), (>=))+import qualified GHC.Exts+import Numeric.Natural (Natural)+import Prelude (Bool (..), Enum, Int, Integer, Integral, Maybe (..), Word, const, enumFrom, enumFromThen, flip, id, maxBound, minBound, not, otherwise, snd, uncurry, (&&), (+), (-), (.), (||))++#if MIN_VERSION_base(4,10,0)+import GHC.Exts (oneShot)+#else+import GHC.Magic (oneShot)+#endif++import Data.List.Infinite.Internal+import Data.List.Infinite.Zip++-- | Right-associative fold of an infinite list, necessarily lazy in the accumulator.+-- Any unconditional attempt to force the accumulator even to WHNF+-- will hang the computation. E. g., the following definition isn't productive:+--+-- > import Data.List.NonEmpty (NonEmpty(..))+-- > toNonEmpty = foldr (\a (x :| xs) -> a :| x : xs) :: Infinite a -> NonEmpty a+--+-- One should use lazy patterns, e. g.,+--+-- > toNonEmpty = foldr (\a ~(x :| xs) -> a :| x : xs)+foldr :: (a -> b -> b) -> Infinite a -> b+foldr f = go+ where+ go (x :< xs) = f x (go xs)+{-# INLINE [0] foldr #-}++{-# RULES+"foldr/build" forall cons (g :: forall b. (a -> b -> b) -> b).+ foldr cons (build g) =+ g cons+"foldr/cons/build" forall cons x (g :: forall b. (a -> b -> b) -> b).+ foldr cons (x :< build g) =+ cons x (g cons)+ #-}++-- | Convert to a list. Use 'cycle' to go in another direction.+toList :: Infinite a -> [a]+toList = foldr (:)+{-# NOINLINE [0] toList #-}++{-# RULES+"toList" [~1] forall xs.+ toList xs =+ GHC.Exts.build (\cons -> const (foldr cons xs))+ #-}++-- | Generate infinite sequences, starting from a given element,+-- similar to @[x..]@.+-- For better user experience consider enabling @{\-# LANGUAGE PostfixOperators #-\}@:+--+-- >>> :set -XPostfixOperators+-- >>> Data.List.Infinite.take 10 (0...)+-- [0,1,2,3,4,5,6,7,8,9]+--+-- Beware that for finite types '(...)' applies 'cycle' atop of @[x..]@:+--+-- >>> :set -XPostfixOperators+-- >>> Data.List.Infinite.take 10 (EQ...)+-- [EQ,GT,EQ,GT,EQ,GT,EQ,GT,EQ,GT]+(...) :: Enum a => a -> Infinite a+(...) = unsafeCycle . enumFrom+{-# INLINE [0] (...) #-}++{-# RULES+"ellipsis3Int" (...) = ellipsis3Int+"ellipsis3Word" (...) = ellipsis3Word+"ellipsis3Integer" (...) = ellipsis3Integer+"ellipsis3Natural" (...) = ellipsis3Natural+ #-}++ellipsis3Int :: Int -> Infinite Int+ellipsis3Int from = iterate' (\n -> if n == maxBound then from else n + 1) from+{-# INLINE ellipsis3Int #-}++ellipsis3Word :: Word -> Infinite Word+ellipsis3Word from = iterate' (\n -> if n == maxBound then from else n + 1) from+{-# INLINE ellipsis3Word #-}++ellipsis3Integer :: Integer -> Infinite Integer+ellipsis3Integer = iterate' (+ 1)+{-# INLINE ellipsis3Integer #-}++ellipsis3Natural :: Natural -> Infinite Natural+ellipsis3Natural = iterate' (+ 1)+{-# INLINE ellipsis3Natural #-}++-- | Generate infinite sequences, starting from given elements,+-- similar to @[x,y..]@.+-- For better user experience consider enabling @{\-# LANGUAGE PostfixOperators #-\}@:+--+-- >>> :set -XPostfixOperators+-- >>> Data.List.Infinite.take 10 ((1,3)....)+-- [1,3,5,7,9,11,13,15,17,19]+--+-- Beware that for finite types '(....)' applies 'cycle' atop of @[x,y..]@:+--+-- >>> :set -XPostfixOperators+-- >>> Data.List.Infinite.take 10 ((EQ,GT)....)+-- [EQ,GT,EQ,GT,EQ,GT,EQ,GT,EQ,GT]+(....) :: Enum a => (a, a) -> Infinite a+(....) = unsafeCycle . uncurry enumFromThen+{-# INLINE [0] (....) #-}++{-# RULES+"ellipsis4Int" (....) = ellipsis4Int+"ellipsis4Word" (....) = ellipsis4Word+"ellipsis4Integer" (....) = ellipsis4Integer+"ellipsis4Natural" (....) = ellipsis4Natural+ #-}++ellipsis4Int :: (Int, Int) -> Infinite Int+ellipsis4Int (from, thn)+ | from <= thn =+ let d = thn - from+ in iterate' (\n -> if n > maxBound - d then from else n + d) from+ | otherwise =+ let d = from - thn+ in iterate' (\n -> if n < minBound + d then from else n - d) from+{-# INLINE ellipsis4Int #-}++ellipsis4Word :: (Word, Word) -> Infinite Word+ellipsis4Word (from, thn)+ | from <= thn =+ let d = thn - from+ in iterate' (\n -> if n > maxBound - d then from else n + d) from+ | otherwise =+ let d = from - thn+ in iterate' (\n -> if n < d then from else n - d) from+{-# INLINE ellipsis4Word #-}++ellipsis4Integer :: (Integer, Integer) -> Infinite Integer+ellipsis4Integer (from, thn) = iterate' (+ (thn - from)) from+{-# INLINE ellipsis4Integer #-}++ellipsis4Natural :: (Natural, Natural) -> Infinite Natural+ellipsis4Natural (from, thn)+ | from <= thn =+ iterate' (+ (thn - from)) from+ | otherwise =+ let d = from - thn+ in iterate' (\n -> if n < d then from else n - d) from+{-# INLINE ellipsis4Natural #-}++-- | Just a pointwise 'map'.+instance Functor Infinite where+ fmap = map+ (<$) = const . repeat++-- | This instance operates pointwise, similar to 'Control.Applicative.ZipList'.+instance Applicative Infinite where+ pure = repeat+ (f :< fs) <*> (x :< xs) = f x :< (fs <*> xs)+ (<*) = const+ (*>) = const id+#if MIN_VERSION_base(4,10,0)+ liftA2 = zipWith+#endif++-- | 'Control.Applicative.ZipList' cannot be made a lawful 'Monad',+-- but 'Infinite', being a+-- <https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable Representable>,+-- can. Namely, 'Control.Monad.join'+-- picks up a diagonal of an infinite matrix of 'Infinite' ('Infinite' @a@).+-- This is mostly useful for parallel list comprehensions once+-- @{\-# LANGUAGE MonadComprehensions #-\}@ is enabled.+instance Monad Infinite where+ xs >>= f = go 0 xs+ where+ go n (y :< ys) = f y !! n :< go (n + 1) ys+ (>>) = (*>)++-- | Get the first elements of an infinite list.+head :: Infinite a -> a+head (x :< _) = x+{-# NOINLINE [1] head #-}++{-# RULES+"head/build" forall (g :: forall b. (a -> b -> b) -> b).+ head (build g) =+ g const+ #-}++-- | Get the elements of an infinite list after the first one.+tail :: Infinite a -> Infinite a+tail (_ :< xs) = xs++-- | Split an infinite list into its 'head' and 'tail'.+uncons :: Infinite a -> (a, Infinite a)+uncons (x :< xs) = (x, xs)++-- | Apply a function to every element of an infinite list.+map :: (a -> b) -> Infinite a -> Infinite b+map = foldr . ((:<) .)++mapFB :: (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst+mapFB = (.)++{-# NOINLINE [0] map #-}++{-# INLINE [0] mapFB #-}++{-# RULES+"map" [~1] forall f xs.+ map f xs =+ build (\cons -> foldr (mapFB cons f) xs)+"mapList" [1] forall f.+ foldr (mapFB (:<) f) =+ map f+"mapFB" forall cons f g.+ mapFB (mapFB cons f) g =+ mapFB cons (f . g)+"map/coerce" [1]+ map coerce =+ coerce+ #-}++-- | Flatten out an infinite list of non-empty lists.+concat :: Infinite (NonEmpty a) -> Infinite a+concat = foldr (\(x :| xs) acc -> x :< (xs `prependList` acc))+{-# NOINLINE [1] concat #-}++{-# RULES+"concat" forall xs.+ concat xs =+ build (\cons -> foldr (flip (F.foldr cons)) xs)+ #-}++-- | First 'map' every element, then 'concat'.+concatMap :: (a -> NonEmpty b) -> Infinite a -> Infinite b+concatMap f = foldr (\a acc -> let (x :| xs) = f a in x :< (xs `prependList` acc))+{-# NOINLINE [1] concatMap #-}++{-# RULES+"concatMap" forall f xs.+ concatMap f xs =+ build (\cons -> foldr (flip (F.foldr cons) . f) xs)+ #-}++-- | Interleave two infinite lists.+interleave :: Infinite a -> Infinite a -> Infinite a+interleave (x :< xs) ys = x :< interleave ys xs++-- | Insert an element between adjacent elements of an infinite list.+intersperse :: a -> Infinite a -> Infinite a+intersperse a = foldr (\x -> (x :<) . (a :<))+{-# NOINLINE [1] intersperse #-}++{-# RULES+"intersperse" forall a xs.+ intersperse a xs =+ build (\cons -> foldr (\x -> cons x . cons a) xs)+ #-}++-- | Insert a non-empty list between adjacent elements of an infinite list,+-- and subsequently flatten it out.+intercalate :: NonEmpty a -> Infinite [a] -> Infinite a+intercalate ~(a :| as) = foldr (\xs -> prependList xs . (a :<) . prependList as)+{-# NOINLINE [1] intercalate #-}++{-# RULES+"intercalate" forall as xss.+ intercalate as xss =+ build (\cons -> foldr (\xs acc -> F.foldr cons (F.foldr cons acc as) xs) xss)+ #-}++-- | Transpose rows and columns of an argument.+--+-- This is actually @distribute@ from+-- <https://hackage.haskell.org/package/distributive/docs/Data-Distributive.html#t:Distributive Distributive>+-- type class in disguise.+transpose :: Functor f => f (Infinite a) -> Infinite (f a)+transpose xss = fmap head xss :< transpose (fmap tail xss)++-- | Generate an infinite list of all subsequences of the argument.+subsequences :: Infinite a -> Infinite [a]+subsequences = ([] :<) . map NE.toList . subsequences1++-- | Generate an infinite list of all non-empty subsequences of the argument.+subsequences1 :: Infinite a -> Infinite (NonEmpty a)+subsequences1 (x :< xs) = (x :| []) :< foldr f (subsequences1 xs)+ where+ f ys r = ys :< (x `NE.cons` ys) :< r++-- | Generate an infinite list of all permutations of the argument.+permutations :: Infinite a -> Infinite (Infinite a)+permutations xs0 = xs0 :< perms xs0 []+ where+ perms :: forall a. Infinite a -> [a] -> Infinite (Infinite a)+ perms (t :< ts) is = List.foldr interleaveList (perms ts (t : is)) (List.permutations is)+ where+ interleaveList :: [a] -> Infinite (Infinite a) -> Infinite (Infinite a)+ interleaveList = (snd .) . interleaveList' id++ interleaveList' :: (Infinite a -> b) -> [a] -> Infinite b -> (Infinite a, Infinite b)+ interleaveList' _ [] r = (ts, r)+ interleaveList' f (y : ys) r = (y :< us, f (t :< y :< us) :< zs)+ where+ (us, zs) = interleaveList' (f . (y :<)) ys r++-- |+-- > scanl f acc (x1 :< x2 :< ...) = acc :< f acc x1 :< f (f acc x1) x2 :< ...+scanl :: (b -> a -> b) -> b -> Infinite a -> Infinite b+scanl f = go+ where+ go z ~(x :< xs) = z :< go (f z x) xs++scanlFB :: (elt' -> elt -> elt') -> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst+scanlFB f cons = \elt g -> oneShot (\x -> let elt' = f x elt in elt' `cons` g elt')++{-# NOINLINE [1] scanl #-}++{-# INLINE [0] scanlFB #-}++{-# RULES+"scanl" [~1] forall f a bs.+ scanl f a bs =+ build (\cons -> a `cons` foldr (scanlFB f cons) bs a)+"scanlList" [1] forall f (a :: a) bs.+ foldr (scanlFB f (:<)) bs a =+ tail (scanl f a bs)+ #-}++-- | Same as 'scanl', but strict in accumulator.+scanl' :: (b -> a -> b) -> b -> Infinite a -> Infinite b+scanl' f = go+ where+ go !z ~(x :< xs) = z :< go (f z x) xs++scanlFB' :: (elt' -> elt -> elt') -> (elt' -> lst -> lst) -> elt -> (elt' -> lst) -> elt' -> lst+scanlFB' f cons = \elt g -> oneShot (\x -> let !elt' = f x elt in elt' `cons` g elt')++{-# NOINLINE [1] scanl' #-}++{-# INLINE [0] scanlFB' #-}++{-# RULES+"scanl'" [~1] forall f a bs.+ scanl' f a bs =+ build (\cons -> a `cons` foldr (scanlFB' f cons) bs a)+"scanlList'" [1] forall f (a :: a) bs.+ foldr (scanlFB' f (:<)) bs a =+ tail (scanl' f a bs)+ #-}++-- |+-- > scanl1 f (x0 :< x1 :< x2 :< ...) = x0 :< f x0 x1 :< f (f x0 x1) x2 :< ...+scanl1 :: (a -> a -> a) -> Infinite a -> Infinite a+scanl1 f (x :< xs) = scanl f x xs++-- | If you are looking how to traverse with a state, look no further:+--+-- > mapAccumL f acc0 (x1 :< x2 :< ...) =+-- > let (acc1, y1) = f acc0 x1 in+-- > let (acc2, y2) = f acc1 x2 in+-- > ...+-- > y1 :< y2 :< ...+mapAccumL :: (acc -> x -> (acc, y)) -> acc -> Infinite x -> Infinite y+mapAccumL f = go+ where+ go s (x :< xs) = y :< go s' xs+ where+ (s', y) = f s x++mapAccumLFB :: (acc -> x -> (acc, y)) -> x -> (acc -> Infinite y) -> acc -> Infinite y+mapAccumLFB f = \x r -> oneShot (\s -> let (s', y) = f s x in y :< r s')++{-# NOINLINE [1] mapAccumL #-}++{-# INLINE [0] mapAccumLFB #-}++{-# RULES+"mapAccumL" [~1] forall f s xs.+ mapAccumL f s xs =+ foldr (mapAccumLFB f) xs s+"mapAccumLList" [1] forall f s xs.+ foldr (mapAccumLFB f) xs s =+ mapAccumL f s xs+ #-}++-- | Generate an infinite list of repeated applications.+iterate :: (a -> a) -> a -> Infinite a+iterate f = go+ where+ go x = x :< go (f x)++iterateFB :: (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst+iterateFB cons f = go+ where+ go x = x `cons` go (f x)++{-# NOINLINE [1] iterate #-}++{-# INLINE [0] iterateFB #-}++{-# RULES+"iterate" [~1] forall f x. iterate f x = build (\cons -> iterateFB cons f x)+"iterateFB" [1] iterateFB (:<) = iterate+ #-}++-- | Same as 'iterate', but strict in accumulator.+iterate' :: (a -> a) -> a -> Infinite a+iterate' f = go+ where+ go !x = x :< go (f x)++iterateFB' :: (elt -> lst -> lst) -> (elt -> elt) -> elt -> lst+iterateFB' cons f = go+ where+ go !x = x `cons` go (f x)++{-# NOINLINE [1] iterate' #-}++{-# INLINE [0] iterateFB' #-}++{-# RULES+"iterate'" [~1] forall f x. iterate' f x = build (\cons -> iterateFB' cons f x)+"iterateFB'" [1] iterateFB' (:<) = iterate'+ #-}++-- | Repeat the same element ad infinitum.+repeat :: a -> Infinite a+repeat x = go+ where+ go = x :< go++repeatFB :: (elt -> lst -> lst) -> elt -> lst+repeatFB cons x = go+ where+ go = x `cons` go++{-# NOINLINE [1] repeat #-}++{-# INLINE [0] repeatFB #-}++{-# RULES+"repeat" [~1] forall x. repeat x = build (`repeatFB` x)+"repeatFB" [1] repeatFB (:<) = repeat+ #-}++-- | Repeat a non-empty list ad infinitum.+-- If you were looking for something like @fromList :: [a] -> Infinite a@,+-- look no further.+cycle :: NonEmpty a -> Infinite a+cycle (x :| xs) = unsafeCycle (x : xs)+{-# INLINE cycle #-}++unsafeCycle :: [a] -> Infinite a+unsafeCycle xs = go+ where+ go = xs `prependList` go++unsafeCycleFB :: (elt -> lst -> lst) -> [elt] -> lst+unsafeCycleFB cons xs = go+ where+ go = F.foldr cons go xs++{-# NOINLINE [1] unsafeCycle #-}++{-# INLINE [0] unsafeCycleFB #-}++{-# RULES+"unsafeCycle" [~1] forall x. unsafeCycle x = build (`unsafeCycleFB` x)+"unsafeCycleFB" [1] unsafeCycleFB (:<) = unsafeCycle+ #-}++-- | Build an infinite list from a seed value.+unfoldr :: (b -> (a, b)) -> b -> Infinite a+unfoldr f = go+ where+ go b = let (a, b') = f b in a :< go b'+{-# INLINE unfoldr #-}++-- | Generate an infinite list of @f@ 0, @f@ 1, @f@ 2...+--+-- 'tabulate' and '(!!)' witness that 'Infinite' is+-- <https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable Representable>.+tabulate :: (Word -> a) -> Infinite a+tabulate f = unfoldr (\n -> (f n, n + 1)) 0+{-# INLINE tabulate #-}++-- | Take a prefix of given length.+take :: Int -> Infinite a -> [a]+take = GHC.Exts.inline genericTake++takeFB :: (elt -> lst -> lst) -> lst -> elt -> (Int -> lst) -> Int -> lst+takeFB cons nil x xs = \m -> if m <= 1 then x `cons` nil else x `cons` xs (m - 1)++{-# INLINE [1] take #-}++{-# INLINE [0] takeFB #-}++{-# RULES+"take" [~1] forall n xs.+ take n xs =+ GHC.Exts.build+ ( \cons nil ->+ if n >= 1+ then foldr (takeFB cons nil) xs n+ else nil+ )+"takeList" [1] forall n xs.+ foldr (takeFB (:) []) xs n =+ take n xs+ #-}++-- | Take a prefix of given length.+genericTake :: Integral i => i -> Infinite a -> [a]+genericTake n+ | n < 1 = const []+ | otherwise = unsafeTake n+ where+ unsafeTake 1 (x :< _) = [x]+ unsafeTake m (x :< xs) = x : unsafeTake (m - 1) xs++-- | Drop a prefix of given length.+drop :: Int -> Infinite a -> Infinite a+drop = GHC.Exts.inline genericDrop++dropFB :: (elt -> lst -> lst) -> elt -> (Int -> lst) -> Int -> lst+dropFB cons x xs = \m -> if m < 1 then x `cons` xs m else xs (m - 1)++{-# INLINE [1] drop #-}++{-# INLINE [0] dropFB #-}++{-# RULES+"drop" [~1] forall n xs.+ drop n xs =+ build+ ( \cons ->+ if n >= 1+ then foldr (dropFB cons) xs n+ else foldr cons xs+ )+"dropList" [1] forall n xs.+ foldr (dropFB (:<)) xs n =+ drop n xs+ #-}++-- | Drop a prefix of given length.+genericDrop :: Integral i => i -> Infinite a -> Infinite a+genericDrop n+ | n < 1 = id+ | otherwise = unsafeDrop n+ where+ unsafeDrop 1 (_ :< xs) = xs+ unsafeDrop m (_ :< xs) = unsafeDrop (m - 1) xs++-- | Split an infinite list into a prefix of given length and the rest.+splitAt :: Int -> Infinite a -> ([a], Infinite a)+splitAt = GHC.Exts.inline genericSplitAt++-- | Split an infinite list into a prefix of given length and the rest.+genericSplitAt :: Integral i => i -> Infinite a -> ([a], Infinite a)+genericSplitAt n+ | n < 1 = ([],)+ | otherwise = unsafeSplitAt n+ where+ unsafeSplitAt 1 (x :< xs) = ([x], xs)+ unsafeSplitAt m (x :< xs) = first (x :) (unsafeSplitAt (m - 1) xs)++-- | Take the longest prefix satisfying a predicate.+takeWhile :: (a -> Bool) -> Infinite a -> [a]+takeWhile p = go+ where+ go (x :< xs)+ | p x = x : go xs+ | otherwise = []++takeWhileFB :: (elt -> Bool) -> (elt -> lst -> lst) -> lst -> elt -> lst -> lst+takeWhileFB p cons nil = \x r -> if p x then x `cons` r else nil++{-# NOINLINE [1] takeWhile #-}++{-# INLINE [0] takeWhileFB #-}++{-# RULES+"takeWhile" [~1] forall p xs.+ takeWhile p xs =+ GHC.Exts.build (\cons nil -> foldr (takeWhileFB p cons nil) xs)+"takeWhileList" [1] forall p.+ foldr (takeWhileFB p (:) []) =+ takeWhile p+ #-}++-- | Drop the longest prefix satisfying a predicate.+--+-- This function isn't productive (e. g., 'head' . 'dropWhile' @f@ won't terminate),+-- if all elements of the input list satisfy the predicate.+dropWhile :: (a -> Bool) -> Infinite a -> Infinite a+dropWhile p = go+ where+ go xxs@(x :< xs)+ | p x = go xs+ | otherwise = xxs++dropWhileFB :: (elt -> Bool) -> (elt -> lst -> lst) -> elt -> (Bool -> lst) -> (Bool -> lst)+dropWhileFB p cons = \x r drp -> if drp && p x then r True else x `cons` r False++{-# NOINLINE [1] dropWhile #-}++{-# INLINE [0] dropWhileFB #-}++{-# RULES+"dropWhile" [~1] forall p xs.+ dropWhile p xs =+ build (\cons -> foldr (dropWhileFB p cons) xs True)+"dropWhileList" [1] forall p xs.+ foldr (dropWhileFB p (:<)) xs True =+ dropWhile p xs+ #-}++-- | Split an infinite list into the longest prefix satisfying a predicate and the rest.+--+-- This function isn't productive in the second component of the tuple+-- (e. g., 'head' . 'snd' . 'span' @f@ won't terminate),+-- if all elements of the input list satisfy the predicate.+span :: (a -> Bool) -> Infinite a -> ([a], Infinite a)+span p = go+ where+ go xxs@(x :< xs)+ | p x = first (x :) (go xs)+ | otherwise = ([], xxs)++-- | Split an infinite list into the longest prefix /not/ satisfying a predicate and the rest.+--+-- This function isn't productive in the second component of the tuple+-- (e. g., 'head' . 'snd' . 'break' @f@ won't terminate),+-- if no elements of the input list satisfy the predicate.+break :: (a -> Bool) -> Infinite a -> ([a], Infinite a)+break = span . (not .)++-- | If a list is a prefix of an infinite list, strip it and return the rest.+-- Otherwise return 'Nothing'.+stripPrefix :: Eq a => [a] -> Infinite a -> Maybe (Infinite a)+stripPrefix [] ys = Just ys+stripPrefix (x : xs) (y :< ys)+ | x == y = stripPrefix xs ys+ | otherwise = Nothing++-- | Group consecutive equal elements.+group :: Eq a => Infinite a -> Infinite (NonEmpty a)+group = groupBy (==)++-- | Overloaded version of 'group'.+groupBy :: (a -> a -> Bool) -> Infinite a -> Infinite (NonEmpty a)+groupBy f = go+ where+ go (x :< xs) = (x :| ys) :< go zs+ where+ (ys, zs) = span (f x) xs++-- | Generate all prefixes of an infinite list.+inits :: Infinite a -> Infinite [a]+inits =+ map (\(SnocBuilder _ front rear) -> front List.++ List.reverse rear)+ . scanl'+ (\(SnocBuilder count front rear) x -> snocBuilder (count + 1) front (x : rear))+ (SnocBuilder 0 [] [])++data SnocBuilder a = SnocBuilder+ { _count :: !Word+ , _front :: [a]+ , _rear :: [a]+ }++snocBuilder :: Word -> [a] -> [a] -> SnocBuilder a+snocBuilder count front rear+ | count < 8 || (count .&. (count + 1)) /= 0 =+ SnocBuilder count front rear+ | otherwise =+ SnocBuilder count (front List.++ List.reverse rear) []+{-# INLINE snocBuilder #-}++-- | Generate all non-empty prefixes of an infinite list.+inits1 :: Infinite a -> Infinite (NonEmpty a)+inits1 (x :< xs) = map (x :|) (inits xs)++-- | Generate all suffixes of an infinite list.+tails :: Infinite a -> Infinite (Infinite a)+tails = foldr (\x xss@(~(xs :< _)) -> (x :< xs) :< xss)++-- | Check whether a list is a prefix of an infinite list.+isPrefixOf :: Eq a => [a] -> Infinite a -> Bool+isPrefixOf [] _ = True+isPrefixOf (x : xs) (y :< ys)+ | x == y = isPrefixOf xs ys+ | otherwise = False++-- | Find the first pair, whose first component is equal to the first argument,+-- and return the second component.+-- If there is nothing to be found, this function will hang indefinitely.+lookup :: Eq a => a -> Infinite (a, b) -> b+lookup a = foldr (\(a', b) b' -> if a == a' then b else b')++-- | Find the first element, satisfying a predicate.+-- If there is nothing to be found, this function will hang indefinitely.+find :: (a -> Bool) -> Infinite a -> a+find f = foldr (\a a' -> if f a then a else a')++-- | Filter an infinite list, removing elements which does not satisfy a predicate.+--+-- This function isn't productive (e. g., 'head' . 'filter' @f@ won't terminate),+-- if no elements of the input list satisfy the predicate.+filter :: (a -> Bool) -> Infinite a -> Infinite a+filter f = foldr (\a -> if f a then (a :<) else id)++filterFB :: (elt -> lst -> lst) -> (elt -> Bool) -> elt -> lst -> lst+filterFB cons f x r+ | f x = x `cons` r+ | otherwise = r++{-# NOINLINE [1] filter #-}++{-# INLINE [0] filterFB #-}++{-# RULES+"filter" [~1] forall f xs.+ filter f xs =+ build (\cons -> foldr (filterFB cons f) xs)+"filterList" [1] forall f.+ foldr (filterFB (:<) f) =+ filter f+"filterFB" forall cons f g.+ filterFB (filterFB cons f) g =+ filterFB cons (\x -> f x && g x)+ #-}++-- | Split an infinite list into two infinite lists: the first one contains elements,+-- satisfying a predicate, and the second one the rest.+--+-- This function isn't productive in the first component of the tuple+-- (e. g., 'head' . 'Data.Tuple.fst' . 'partition' @f@ won't terminate),+-- if no elements of the input list satisfy the predicate.+-- Same for the second component,+-- if all elements of the input list satisfy the predicate.+partition :: (a -> Bool) -> Infinite a -> (Infinite a, Infinite a)+partition f = foldr (\a -> if f a then first (a :<) else second (a :<))++-- | Return /n/-th element of an infinite list.+-- On contrary to @Data.List.@'List.!!', this function takes 'Word' instead of 'Int'+-- to avoid 'Prelude.error' on negative arguments.+--+-- This is actually @index@ from+-- <https://hackage.haskell.org/package/adjunctions/docs/Data-Functor-Rep.html#t:Representable Representable>+-- type class in disguise.+(!!) :: Infinite a -> Word -> a+(!!) = flip go+ where+ go 0 (x :< _) = x+ go !m (_ :< ys) = go (m - 1) ys++infixl 9 !!++-- | Return an index of the first element, equal to a given.+-- If there is nothing to be found, this function will hang indefinitely.+elemIndex :: Eq a => a -> Infinite a -> Word+elemIndex = findIndex . (==)++-- | Return indices of all elements, equal to a given.+--+-- This function isn't productive (e. g., 'head' . 'elemIndices' @f@ won't terminate),+-- if no elements of the input list are equal the given one.+elemIndices :: Eq a => a -> Infinite a -> Infinite Word+elemIndices = findIndices . (==)++-- | Return an index of the first element, satisfying a predicate.+-- If there is nothing to be found, this function will hang indefinitely.+findIndex :: (a -> Bool) -> Infinite a -> Word+findIndex f = go 0+ where+ go !n (x :< xs)+ | f x = n+ | otherwise = go (n + 1) xs++-- | Return indices of all elements, satisfying a predicate.+--+-- This function isn't productive (e. g., 'head' . 'elemIndices' @f@ won't terminate),+-- if no elements of the input list satisfy the predicate.+findIndices :: (a -> Bool) -> Infinite a -> Infinite Word+findIndices f = go 0+ where+ go !n (x :< xs) = (if f x then (n :<) else id) (go (n + 1) xs)++-- | Unzip an infinite list of tuples.+unzip :: Infinite (a, b) -> (Infinite a, Infinite b)+unzip = foldr (\(a, b) ~(as, bs) -> (a :< as, b :< bs))+{-# INLINE unzip #-}++-- | Unzip an infinite list of triples.+unzip3 :: Infinite (a, b, c) -> (Infinite a, Infinite b, Infinite c)+unzip3 = foldr (\(a, b, c) ~(as, bs, cs) -> (a :< as, b :< bs, c :< cs))+{-# INLINE unzip3 #-}++-- | Unzip an infinite list of quadruples.+unzip4 :: Infinite (a, b, c, d) -> (Infinite a, Infinite b, Infinite c, Infinite d)+unzip4 = foldr (\(a, b, c, d) ~(as, bs, cs, ds) -> (a :< as, b :< bs, c :< cs, d :< ds))+{-# INLINE unzip4 #-}++-- | Unzip an infinite list of quintuples.+unzip5 :: Infinite (a, b, c, d, e) -> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e)+unzip5 = foldr (\(a, b, c, d, e) ~(as, bs, cs, ds, es) -> (a :< as, b :< bs, c :< cs, d :< ds, e :< es))+{-# INLINE unzip5 #-}++-- | Unzip an infinite list of sextuples.+unzip6 :: Infinite (a, b, c, d, e, f) -> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e, Infinite f)+unzip6 = foldr (\(a, b, c, d, e, f) ~(as, bs, cs, ds, es, fs) -> (a :< as, b :< bs, c :< cs, d :< ds, e :< es, f :< fs))+{-# INLINE unzip6 #-}++-- | Unzip an infinite list of septuples.+unzip7 :: Infinite (a, b, c, d, e, f, g) -> (Infinite a, Infinite b, Infinite c, Infinite d, Infinite e, Infinite f, Infinite g)+unzip7 = foldr (\(a, b, c, d, e, f, g) ~(as, bs, cs, ds, es, fs, gs) -> (a :< as, b :< bs, c :< cs, d :< ds, e :< es, f :< fs, g :< gs))+{-# INLINE unzip7 #-}++-- | Split an infinite string into lines, by @\\n@.+lines :: Infinite Char -> Infinite [Char]+lines xs = l :< lines xs'+ where+ (l, ~(_ :< xs')) = break (== '\n') xs++-- | Concatenate lines together with @\\n@.+unlines :: Infinite [Char] -> Infinite Char+unlines = foldr (\l xs -> l `prependList` ('\n' :< xs))++-- | Split an infinite string into words, by any 'isSpace' symbol.+words :: Infinite Char -> Infinite (NonEmpty Char)+words xs = (u :| us) :< words vs+ where+ u :< ys = dropWhile isSpace xs+ (us, vs) = break isSpace ys++wordsFB :: (NonEmpty Char -> lst -> lst) -> Infinite Char -> lst+wordsFB cons = go+ where+ go xs = (u :| us) `cons` go vs+ where+ u :< ys = dropWhile isSpace xs+ (us, vs) = break isSpace ys++{-# NOINLINE [1] words #-}++{-# INLINE [0] wordsFB #-}++{-# RULES+"words" [~1] forall s. words s = build (`wordsFB` s)+"wordsList" [1] wordsFB (:<) = words+ #-}++-- | Concatenate words together with a space.+unwords :: Infinite (NonEmpty Char) -> Infinite Char+unwords = foldr (\(l :| ls) acc -> l :< ls `prependList` (' ' :< acc))++unwordsFB :: (Char -> lst -> lst) -> Infinite (NonEmpty Char) -> lst+unwordsFB cons = foldr (\(l :| ls) acc -> l `cons` List.foldr cons (' ' `cons` acc) ls)++{-# NOINLINE [1] unwords #-}++{-# INLINE [0] unwordsFB #-}++{-# RULES+"unwords" [~1] forall s. unwords s = build (`unwordsFB` s)+"unwordsList" [1] unwordsFB (:<) = unwords+ #-}++-- | Remove duplicate from a list, keeping only the first occurrence of each element.+nub :: Eq a => Infinite a -> Infinite a+nub = nubBy (==)++-- | Overloaded version of 'nub'.+nubBy :: (a -> a -> Bool) -> Infinite a -> Infinite a+nubBy eq = go []+ where+ go seen (x :< xs)+ | elemBy x seen = go seen xs+ | otherwise = x :< go (x : seen) xs++ elemBy _ [] = False+ elemBy y (x : xs) = eq x y || elemBy y xs++-- | Remove all occurrences of an element from an infinite list.+delete :: Eq a => a -> Infinite a -> Infinite a+delete = deleteBy (==)++-- | Overloaded version of 'delete'.+deleteBy :: (a -> b -> Bool) -> a -> Infinite b -> Infinite b+deleteBy eq x = go+ where+ go (y :< ys)+ | eq x y = ys+ | otherwise = y :< go ys++-- | Take an infinite list and remove the first occurrence of every element+-- of a finite list.+(\\) :: Eq a => Infinite a -> [a] -> Infinite a+(\\) = deleteFirstsBy (==)++-- | Overloaded version of '(\\)'.+deleteFirstsBy :: (a -> b -> Bool) -> Infinite b -> [a] -> Infinite b+deleteFirstsBy eq = List.foldl (flip (deleteBy eq))++-- | Union of a finite and an infinite list. It contains the finite list+-- as a prefix and afterwards all non-duplicate elements of the infinite list,+-- which are not members of the finite list.+union :: Eq a => [a] -> Infinite a -> Infinite a+union = unionBy (==)++-- | Overloaded version of 'union'.+unionBy :: (a -> a -> Bool) -> [a] -> Infinite a -> Infinite a+unionBy eq xs ys = xs `prependList` List.foldl (flip (deleteBy eq)) (nubBy eq ys) xs++-- | Insert an element at the first position where it is less than or equal+-- to the next one. If the input was sorted, the output remains sorted as well.+insert :: Ord a => a -> Infinite a -> Infinite a+insert = insertBy compare++-- | Overloaded version of 'insert'.+insertBy :: (a -> a -> Ordering) -> a -> Infinite a -> Infinite a+insertBy cmp x = go+ where+ go yys@(y :< ys) = case cmp x y of+ GT -> y :< go ys+ _ -> x :< yys++-- | Return all elements of an infinite list, which are simultaneously+-- members of a finite list.+intersect :: Eq a => Infinite a -> [a] -> Infinite a+intersect = intersectBy (==)++-- | Overloaded version of 'intersect'.+intersectBy :: (a -> b -> Bool) -> Infinite a -> [b] -> Infinite a+intersectBy eq xs ys = filter (\x -> List.any (eq x) ys) xs++-- | Prepend a list to an infinite list.+prependList :: [a] -> Infinite a -> Infinite a+prependList = flip (F.foldr (:<))
+ src/Data/List/Infinite/Internal.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE RankNTypes #-}++-- |+-- Copyright: (c) 2022 Bodigrim+-- License: BSD3+module Data.List.Infinite.Internal (+ Infinite (..),+ build,+) where++-- | Type of infinite lists.+data Infinite a = a :< Infinite a++infixr 5 :<++build :: forall a. (forall b. (a -> b -> b) -> b) -> Infinite a+build g = g (:<)+{-# INLINE [1] build #-}
+ src/Data/List/Infinite/Zip.hs view
@@ -0,0 +1,336 @@+-- |+-- Copyright: (c) 2022 Bodigrim+-- License: BSD3+module Data.List.Infinite.Zip (+ zip,+ zipWith,+ zip3,+ zipWith3,+ zip4,+ zipWith4,+ zip5,+ zipWith5,+ zip6,+ zipWith6,+ zip7,+ zipWith7,+) where++import Prelude (flip, (.))++import Data.List.Infinite.Internal++-- | Zip two infinite lists.+zip :: Infinite a -> Infinite b -> Infinite (a, b)+zip = zipWith (,)+{-# INLINE zip #-}++-- | Zip two infinite lists with a given function.+zipWith :: (a -> b -> c) -> Infinite a -> Infinite b -> Infinite c+zipWith fun = go+ where+ go (a :< as) (b :< bs) = fun a b :< go as bs++zipWithFB :: (elt -> lst -> lst') -> (a -> b -> elt) -> a -> b -> lst -> lst'+zipWithFB = (.) . (.)++{-# NOINLINE [1] zipWith #-}++{-# INLINE [0] zipWithFB #-}++{-# RULES+"zipWith" [~1] forall f xs ys.+ zipWith f xs ys =+ build (\cons -> foldr2 (zipWithFB cons f) xs ys)+"zipWithList" [1] forall f.+ foldr2 (zipWithFB (:<) f) =+ zipWith f+ #-}++foldr2 :: (elt1 -> elt2 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> lst+foldr2 cons = go+ where+ go (a :< as) (b :< bs) = cons a b (go as bs)+{-# INLINE [0] foldr2 #-}++foldr2_left :: (elt1 -> elt2 -> lst -> lst') -> elt1 -> (Infinite elt2 -> lst) -> Infinite elt2 -> lst'+foldr2_left cons a r (b :< bs) = cons a b (r bs)++{-# RULES+"foldr2/1" forall (cons :: elt1 -> elt2 -> lst -> lst) (bs :: Infinite elt2) (g :: forall b. (elt1 -> b -> b) -> b).+ foldr2 cons (build g) bs =+ g (foldr2_left cons) bs+"foldr2/2" forall (cons :: elt1 -> elt2 -> lst -> lst) (as :: Infinite elt1) (g :: forall b. (elt2 -> b -> b) -> b).+ foldr2 cons as (build g) =+ g (foldr2_left (flip cons)) as+ #-}++-- | Zip three infinite lists.+zip3 :: Infinite a -> Infinite b -> Infinite c -> Infinite (a, b, c)+zip3 = zipWith3 (,,)+{-# INLINE zip3 #-}++-- | Zip three infinite lists with a given function.+zipWith3 :: (a -> b -> c -> d) -> Infinite a -> Infinite b -> Infinite c -> Infinite d+zipWith3 fun = go+ where+ go (a :< as) (b :< bs) (c :< cs) = fun a b c :< go as bs cs++zipWith3FB :: (elt -> lst -> lst') -> (a -> b -> c -> elt) -> a -> b -> c -> lst -> lst'+zipWith3FB = (.) . (.) . (.)++{-# NOINLINE [1] zipWith3 #-}++{-# INLINE [0] zipWith3FB #-}++{-# RULES+"zipWith3" [~1] forall f xs ys zs.+ zipWith3 f xs ys zs =+ build (\cons -> foldr3 (zipWith3FB cons f) xs ys zs)+"zipWith3List" [1] forall f.+ foldr3 (zipWith3FB (:<) f) =+ zipWith3 f+ #-}++foldr3 :: (elt1 -> elt2 -> elt3 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> lst+foldr3 cons = go+ where+ go (a :< as) (b :< bs) (c :< cs) = cons a b c (go as bs cs)+{-# INLINE [0] foldr3 #-}++foldr3_left :: (elt1 -> elt2 -> elt3 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> lst) -> Infinite elt2 -> Infinite elt3 -> lst'+foldr3_left cons a r (b :< bs) (c :< cs) = cons a b c (r bs cs)++{-# RULES+"foldr3/1" forall (cons :: elt1 -> elt2 -> elt3 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (g :: forall b. (elt1 -> b -> b) -> b).+ foldr3 cons (build g) bs cs =+ g (foldr3_left cons) bs cs+"foldr3/2" forall (cons :: elt1 -> elt2 -> elt3 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (g :: forall b. (elt2 -> b -> b) -> b).+ foldr3 cons as (build g) cs =+ g (foldr3_left (flip cons)) as cs+"foldr3/3" forall (cons :: elt1 -> elt2 -> elt3 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (g :: forall b. (elt3 -> b -> b) -> b).+ foldr3 cons as bs (build g) =+ g (foldr3_left (\c a b -> cons a b c)) as bs+ #-}++-- | Zip four infinite lists.+zip4 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite (a, b, c, d)+zip4 = zipWith4 (,,,)+{-# INLINE zip4 #-}++-- | Zip four infinite lists with a given function.+zipWith4 :: (a -> b -> c -> d -> e) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e+zipWith4 fun = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) = fun a b c d :< go as bs cs ds++zipWith4FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> elt) -> a -> b -> c -> d -> lst -> lst'+zipWith4FB = (.) . (.) . (.) . (.)++{-# NOINLINE [1] zipWith4 #-}++{-# INLINE [0] zipWith4FB #-}++{-# RULES+"zipWith4" [~1] forall f xs ys zs ts.+ zipWith4 f xs ys zs ts =+ build (\cons -> foldr4 (zipWith4FB cons f) xs ys zs ts)+"zipWith4List" [1] forall f.+ foldr4 (zipWith4FB (:<) f) =+ zipWith4 f+ #-}++foldr4 :: (elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> lst+foldr4 cons = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) = cons a b c d (go as bs cs ds)+{-# INLINE [0] foldr4 #-}++foldr4_left :: (elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> lst'+foldr4_left cons a r (b :< bs) (c :< cs) (d :< ds) = cons a b c d (r bs cs ds)++{-# RULES+"foldr4/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (g :: forall b. (elt1 -> b -> b) -> b).+ foldr4 cons (build g) bs cs ds =+ g (foldr4_left cons) bs cs ds+"foldr4/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (g :: forall b. (elt2 -> b -> b) -> b).+ foldr4 cons as (build g) cs ds =+ g (foldr4_left (flip cons)) as cs ds+"foldr4/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (g :: forall b. (elt3 -> b -> b) -> b).+ foldr4 cons as bs (build g) ds =+ g (foldr4_left (\c a b d -> cons a b c d)) as bs ds+"foldr4/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (g :: forall b. (elt4 -> b -> b) -> b).+ foldr4 cons as bs cs (build g) =+ g (foldr4_left (\d a b c -> cons a b c d)) as bs cs+ #-}++-- | Zip five infinite lists.+zip5 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite (a, b, c, d, e)+zip5 = zipWith5 (,,,,)+{-# INLINE zip5 #-}++-- | Zip five infinite lists with a given function.+zipWith5 :: (a -> b -> c -> d -> e -> f) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f+zipWith5 fun = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) = fun a b c d e :< go as bs cs ds es++zipWith5FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> e -> elt) -> a -> b -> c -> d -> e -> lst -> lst'+zipWith5FB = (.) . (.) . (.) . (.) . (.)++{-# NOINLINE [1] zipWith5 #-}++{-# INLINE [0] zipWith5FB #-}++{-# RULES+"zipWith5" [~1] forall f xs ys zs ts us.+ zipWith5 f xs ys zs ts us =+ build (\cons -> foldr5 (zipWith5FB cons f) xs ys zs ts us)+"zipWith5List" [1] forall f.+ foldr5 (zipWith5FB (:<) f) =+ zipWith5 f+ #-}++foldr5 :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> lst+foldr5 cons = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) = cons a b c d e (go as bs cs ds es)+{-# INLINE [0] foldr5 #-}++foldr5_left :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> lst'+foldr5_left cons a r (b :< bs) (c :< cs) (d :< ds) (e :< es) = cons a b c d e (r bs cs ds es)++{-# RULES+"foldr5/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt1 -> b -> b) -> b).+ foldr5 cons (build g) bs cs ds es =+ g (foldr5_left cons) bs cs ds es+"foldr5/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt2 -> b -> b) -> b).+ foldr5 cons as (build g) cs ds es =+ g (foldr5_left (flip cons)) as cs ds es+"foldr5/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt3 -> b -> b) -> b).+ foldr5 cons as bs (build g) ds es =+ g (foldr5_left (\c a b d e -> cons a b c d e)) as bs ds es+"foldr5/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (es :: Infinite elt5) (g :: forall b. (elt4 -> b -> b) -> b).+ foldr5 cons as bs cs (build g) es =+ g (foldr5_left (\d a b c e -> cons a b c d e)) as bs cs es+"foldr5/5" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (g :: forall b. (elt5 -> b -> b) -> b).+ foldr5 cons as bs cs ds (build g) =+ g (foldr5_left (\e a b c d -> cons a b c d e)) as bs cs ds+ #-}++-- | Zip six infinite lists.+zip6 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite (a, b, c, d, e, f)+zip6 = zipWith6 (,,,,,)+{-# INLINE zip6 #-}++-- | Zip six infinite lists with a given function.+zipWith6 :: (a -> b -> c -> d -> e -> f -> g) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite g+zipWith6 fun = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) = fun a b c d e f :< go as bs cs ds es fs++zipWith6FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> e -> f -> elt) -> a -> b -> c -> d -> e -> f -> lst -> lst'+zipWith6FB = (.) . (.) . (.) . (.) . (.) . (.)++{-# NOINLINE [1] zipWith6 #-}++{-# INLINE [0] zipWith6FB #-}++{-# RULES+"zipWith6" [~1] forall f xs ys zs ts us vs.+ zipWith6 f xs ys zs ts us vs =+ build (\cons -> foldr6 (zipWith6FB cons f) xs ys zs ts us vs)+"zipWith6List" [1] forall f.+ foldr6 (zipWith6FB (:<) f) =+ zipWith6 f+ #-}++foldr6 :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> lst+foldr6 cons = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) = cons a b c d e f (go as bs cs ds es fs)+{-# INLINE [0] foldr6 #-}++foldr6_left :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> lst'+foldr6_left cons a r (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) = cons a b c d e f (r bs cs ds es fs)++{-# RULES+"foldr6/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt1 -> b -> b) -> b).+ foldr6 cons (build g) bs cs ds es fs =+ g (foldr6_left cons) bs cs ds es fs+"foldr6/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt2 -> b -> b) -> b).+ foldr6 cons as (build g) cs ds es fs =+ g (foldr6_left (flip cons)) as cs ds es fs+"foldr6/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt3 -> b -> b) -> b).+ foldr6 cons as bs (build g) ds es fs =+ g (foldr6_left (\c a b d e f -> cons a b c d e f)) as bs ds es fs+"foldr6/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt4 -> b -> b) -> b).+ foldr6 cons as bs cs (build g) es fs =+ g (foldr6_left (\d a b c e f -> cons a b c d e f)) as bs cs es fs+"foldr6/5" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (fs :: Infinite elt6) (g :: forall b. (elt5 -> b -> b) -> b).+ foldr6 cons as bs cs ds (build g) fs =+ g (foldr6_left (\e a b c d f -> cons a b c d e f)) as bs cs ds fs+"foldr6/6" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (g :: forall b. (elt6 -> b -> b) -> b).+ foldr6 cons as bs cs ds es (build g) =+ g (foldr6_left (\f a b c d e -> cons a b c d e f)) as bs cs ds es+ #-}++-- | Zip seven infinite lists.+zip7 :: Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite g -> Infinite (a, b, c, d, e, f, g)+zip7 = zipWith7 (,,,,,,)+{-# INLINE zip7 #-}++-- | Zip seven infinite lists with a given function.+zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> Infinite a -> Infinite b -> Infinite c -> Infinite d -> Infinite e -> Infinite f -> Infinite g -> Infinite h+zipWith7 fun = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) (g :< gs) = fun a b c d e f g :< go as bs cs ds es fs gs++zipWith7FB :: (elt -> lst -> lst') -> (a -> b -> c -> d -> e -> f -> g -> elt) -> a -> b -> c -> d -> e -> f -> g -> lst -> lst'+zipWith7FB = (.) . (.) . (.) . (.) . (.) . (.) . (.)++{-# NOINLINE [1] zipWith7 #-}++{-# INLINE [0] zipWith7FB #-}++{-# RULES+"zipWith7" [~1] forall f xs ys zs ts us vs ws.+ zipWith7 f xs ys zs ts us vs ws =+ build (\cons -> foldr7 (zipWith7FB cons f) xs ys zs ts us vs ws)+"zipWith7List" [1] forall f.+ foldr7 (zipWith7FB (:<) f) =+ zipWith7 f+ #-}++foldr7 :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) -> Infinite elt1 -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> Infinite elt7 -> lst+foldr7 cons = go+ where+ go (a :< as) (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) (g :< gs) = cons a b c d e f g (go as bs cs ds es fs gs)+{-# INLINE [0] foldr7 #-}++foldr7_left :: (elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst') -> elt1 -> (Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> Infinite elt7 -> lst) -> Infinite elt2 -> Infinite elt3 -> Infinite elt4 -> Infinite elt5 -> Infinite elt6 -> Infinite elt7 -> lst'+foldr7_left cons a r (b :< bs) (c :< cs) (d :< ds) (e :< es) (f :< fs) (g :< gs) = cons a b c d e f g (r bs cs ds es fs gs)++{-# RULES+"foldr7/1" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt1 -> b -> b) -> b).+ foldr7 cons (build g) bs cs ds es fs gs =+ g (foldr7_left cons) bs cs ds es fs gs+"foldr7/2" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt2 -> b -> b) -> b).+ foldr7 cons as (build g) cs ds es fs gs =+ g (foldr7_left (flip cons)) as cs ds es fs gs+"foldr7/3" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt3 -> b -> b) -> b).+ foldr7 cons as bs (build g) ds es fs gs =+ g (foldr7_left (\c a b d e f g' -> cons a b c d e f g')) as bs ds es fs gs+"foldr7/4" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (es :: Infinite elt5) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt4 -> b -> b) -> b).+ foldr7 cons as bs cs (build g) es fs gs =+ g (foldr7_left (\d a b c e f g' -> cons a b c d e f g')) as bs cs es fs gs+"foldr7/5" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (fs :: Infinite elt6) (gs :: Infinite elt7) (g :: forall b. (elt5 -> b -> b) -> b).+ foldr7 cons as bs cs ds (build g) fs gs =+ g (foldr7_left (\e a b c d f g' -> cons a b c d e f g')) as bs cs ds fs gs+"foldr7/6" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (gs :: Infinite elt7) (g :: forall b. (elt6 -> b -> b) -> b).+ foldr7 cons as bs cs ds es (build g) gs =+ g (foldr7_left (\f a b c d e g' -> cons a b c d e f g')) as bs cs ds es gs+"foldr7/7" forall (cons :: elt1 -> elt2 -> elt3 -> elt4 -> elt5 -> elt6 -> elt7 -> lst -> lst) (as :: Infinite elt1) (bs :: Infinite elt2) (cs :: Infinite elt3) (ds :: Infinite elt4) (es :: Infinite elt5) (fs :: Infinite elt6) (g :: forall b. (elt7 -> b -> b) -> b).+ foldr7 cons as bs cs ds es fs (build g) =+ g (foldr7_left (\g' a b c d e f -> cons a b c d e f g')) as bs cs ds es fs+ #-}
+ test/Fusion.hs view
@@ -0,0 +1,332 @@+-- |+-- Copyright: (c) 2022 Bodigrim+-- Licence: BSD3++{-# LANGUAGE PostfixOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -O -dsuppress-all -dno-suppress-type-signatures -fplugin=Test.Tasty.Inspection.Plugin #-}++module Main where++import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.Inspection+import Test.Tasty.Runners++import Data.Coerce+import Data.Ord+import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as I+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE++foldrMap :: Infinite Int -> Infinite Int+foldrMap xs = I.foldr (\x acc -> fromIntegral x :< acc) (I.map fromIntegral xs :: Infinite Word)++foldrConsMap :: Int -> Infinite Int -> Infinite Int+foldrConsMap i xs = I.foldr (\x acc -> fromIntegral x :< acc) (fromIntegral i :< (I.map fromIntegral xs :: Infinite Word))++mapMap :: Infinite Int -> Infinite Int+mapMap xs = I.map fromIntegral (I.map fromIntegral xs :: Infinite Word)++mapId :: Infinite Int -> Infinite Int+mapId xs = I.map id (I.map id xs)++mapCoerce :: Infinite Int -> Infinite (Down Int)+mapCoerce xs = I.map coerce xs++headIterate :: Int -> Int+headIterate x = I.head (I.iterate (+ 1) x)++foldrIterate :: Int -> [Int]+foldrIterate x = I.foldr (\a acc -> a : a : acc) (I.iterate (+ 1) x)++foldrIterate' :: Int -> [Int]+foldrIterate' x = I.foldr (\a acc -> a : a : acc) (I.iterate (+ 1) x)++foldrRepeat :: Int -> [Int]+foldrRepeat x = I.foldr (\a acc -> a : a : acc) (I.repeat x)++headFilterIterate :: Int -> Int+headFilterIterate x = I.head (I.filter (> 10) (I.iterate (+ 1) x))++filterFilter :: Infinite Int -> Infinite Int+filterFilter xs = I.filter (> 10) (I.filter (> 5) xs)++filterFilter' :: Infinite Int -> Infinite Int+filterFilter' xs = I.filter (\x -> x > 10 && x > 5) xs++foldrScanl :: Infinite Int -> Infinite Int+foldrScanl xs = I.foldr (\a acc -> fromIntegral a :< acc)+ (I.scanl (\_acc a -> fromIntegral a) (0 :: Word) xs)++foldrScanl' :: Infinite Int -> Infinite Int+foldrScanl' xs = I.foldr (\a acc -> fromIntegral a :< acc)+ (I.scanl' (\_acc a -> fromIntegral a) (0 :: Word) xs)++takeRepeat :: Int -> [Int]+takeRepeat x = I.take x (I.repeat x)++takeDropRepeat :: Int -> [Int]+takeDropRepeat x = I.take x (I.drop x (I.repeat x))++takeWhileIterate :: Int -> [Int]+takeWhileIterate x = I.takeWhile (< 10) (I.iterate (+ 1) x)++takeWhileDropWhileIterate :: Int -> [Int]+takeWhileDropWhileIterate x = I.takeWhile (< 20) $ I.dropWhile (< 10) (I.iterate (+ 1) x)++foldrCycle :: NonEmpty Int -> [Int]+foldrCycle xs = I.foldr (:) (I.cycle xs)++foldrWordsCycle :: [Char] -> [Char]+foldrWordsCycle xs = I.foldr (\a acc -> NE.head a : acc) (I.words (I.cycle (' ' :| xs)))++foldrMapAccumL :: Infinite Int -> Infinite Int+foldrMapAccumL xs = I.foldr (\a acc -> fromIntegral a :< acc)+ (I.mapAccumL (\acc x -> (acc, fromIntegral x :: Word)) (0 :: Int) xs)++mapAccumLRepeat :: Int -> Infinite Int+mapAccumLRepeat n =+ I.mapAccumL (\acc x -> (acc, fromIntegral x)) 'q' (I.repeat (fromIntegral n :: Word))+++takeFilterIterate :: [Int]+takeFilterIterate = I.take 100 $ I.filter odd $ I.iterate (+ 1) 0+++sumTakeFilterIterate :: Int+sumTakeFilterIterate = sum $ I.take 100 $ I.filter odd $ I.iterate (+ 1) 0++takeFilterCycle :: [Int]+takeFilterCycle = I.take 100 $ I.filter odd $ I.cycle $ 0 :| [1..]++takeFilterEllipsis3 :: [Int]+takeFilterEllipsis3 = I.take 100 $ I.filter odd (0 I....)++takeFilterEllipsis4 :: [Int]+takeFilterEllipsis4 = I.take 100 $ I.filter odd ((0, 3) I.....)++sumTakeFilterEllipsis3 :: Int+sumTakeFilterEllipsis3 = sum $ I.take 100 $ I.filter odd (0 I....)++sumTakeFilterEllipsis4 :: Int+sumTakeFilterEllipsis4 = sum $ I.take 100 $ I.filter odd ((0, 3) I.....)+++takeToListFilterIterate :: [Int]+takeToListFilterIterate = Prelude.take 100 $ I.toList $ I.filter odd $ I.iterate (+ 1) 0++sumTakeToListFilterIterate :: Int+sumTakeToListFilterIterate = sum $ Prelude.take 100 $ I.toList $ I.filter odd $ I.iterate (+ 1) 0++takeToListFilterCycle :: [Int]+takeToListFilterCycle = Prelude.take 100 $ I.toList $ I.filter odd $ I.cycle $ 0 :| [1..]++takeToListFilterEllipsis3 :: [Int]+takeToListFilterEllipsis3 = Prelude.take 100 $ I.toList $ I.filter odd (0 I....)++takeToListFilterEllipsis4 :: [Int]+takeToListFilterEllipsis4 = Prelude.take 100 $ I.toList $ I.filter odd ((0, 3) I.....)++sumTakeToListFilterEllipsis3 :: Int+sumTakeToListFilterEllipsis3 = sum $ Prelude.take 100 $ I.toList $ I.filter odd (0 I....)++sumTakeToListFilterEllipsis4 :: Int+sumTakeToListFilterEllipsis4 = sum $ Prelude.take 100 $ I.toList $ I.filter odd ((0, 3) I.....)+++headFilterMapEllipsis3 :: Int+headFilterMapEllipsis3 = I.head $ I.filter odd $ I.map (+ 1) (0 I....)++headFilterMapEllipsis4 :: Int+headFilterMapEllipsis4 = I.head $ I.filter odd $ I.map (+ 1) ((0, 3) I.....)++toListConcatRepeat :: [Int]+toListConcatRepeat = I.toList $ I.concat $ I.repeat $ NE.singleton 1++toListConcatMapRepeat :: [Int]+toListConcatMapRepeat = I.toList $ I.concatMap NE.singleton $ I.repeat 1++toListIntersperseRepeat :: [Int]+toListIntersperseRepeat = I.toList $ I.intersperse 1 $ I.repeat 0++toListIntercalateRepeat :: [Int]+toListIntercalateRepeat = I.toList $ I.intercalate (NE.singleton 1) $ I.repeat [0]++headMapZipIterate :: Bool+headMapZipIterate = I.head $ I.map ((> 0) . snd) $ I.zip (I.repeat (1 :: Word)) $ I.iterate id (0 :: Int)++headMapFlipZipIterate :: Bool+headMapFlipZipIterate = I.head $ I.map ((> 0) . fst) $ flip I.zip (I.repeat (1 :: Word)) $ I.iterate id (0 :: Int)++zeros :: Infinite Word+zeros = I.repeat 0+{-# NOINLINE zeros #-}++zipWithRepeat1 :: Infinite Bool+zipWithRepeat1 = I.zipWith (\x y -> x == fromIntegral y) (I.repeat (1 :: Int)) zeros++zipWithRepeat2 :: Infinite Bool+zipWithRepeat2 = I.zipWith (\x y -> y == fromIntegral x) zeros (I.repeat (1 :: Int))++zipWith3Repeat1 :: Infinite Bool+zipWith3Repeat1 = I.zipWith3 (\x y z -> x == fromIntegral (y + z)) (I.repeat (1 :: Int)) zeros zeros++zipWith3Repeat2 :: Infinite Bool+zipWith3Repeat2 = I.zipWith3 (\x y z -> y == fromIntegral (x + z)) zeros (I.repeat (1 :: Int)) zeros++zipWith3Repeat3 :: Infinite Bool+zipWith3Repeat3 = I.zipWith3 (\x y z -> z == fromIntegral (x + y)) zeros zeros (I.repeat (1 :: Int))++zipWith4Repeat1 :: Infinite Bool+zipWith4Repeat1 = I.zipWith4 (\x y z t -> x == fromIntegral (y + z + t)) (I.repeat (1 :: Int)) zeros zeros zeros++zipWith4Repeat2 :: Infinite Bool+zipWith4Repeat2 = I.zipWith4 (\x y z t -> y == fromIntegral (x + z + t)) zeros (I.repeat (1 :: Int)) zeros zeros++zipWith4Repeat3 :: Infinite Bool+zipWith4Repeat3 = I.zipWith4 (\x y z t -> z == fromIntegral (x + y + t)) zeros zeros (I.repeat (1 :: Int)) zeros++zipWith4Repeat4 :: Infinite Bool+zipWith4Repeat4 = I.zipWith4 (\x y z t -> t == fromIntegral (x + y + z)) zeros zeros zeros (I.repeat (1 :: Int))++zipWith5Repeat1 :: Infinite Bool+zipWith5Repeat1 = I.zipWith5 (\x y z t u -> x == fromIntegral (y + z + t + u)) (I.repeat (1 :: Int)) zeros zeros zeros zeros++zipWith5Repeat2 :: Infinite Bool+zipWith5Repeat2 = I.zipWith5 (\x y z t u -> y == fromIntegral (x + z + t + u)) zeros (I.repeat (1 :: Int)) zeros zeros zeros++zipWith5Repeat3 :: Infinite Bool+zipWith5Repeat3 = I.zipWith5 (\x y z t u -> z == fromIntegral (x + y + t + u)) zeros zeros (I.repeat (1 :: Int)) zeros zeros++zipWith5Repeat4 :: Infinite Bool+zipWith5Repeat4 = I.zipWith5 (\x y z t u -> t == fromIntegral (x + y + z + u)) zeros zeros zeros (I.repeat (1 :: Int)) zeros++zipWith5Repeat5 :: Infinite Bool+zipWith5Repeat5 = I.zipWith5 (\x y z t u -> u == fromIntegral (x + y + z + t)) zeros zeros zeros zeros (I.repeat (1 :: Int))++zipWith6Repeat1 :: Infinite Bool+zipWith6Repeat1 = I.zipWith6 (\x y z t u v -> x == fromIntegral (y + z + t + u + v)) (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros++zipWith6Repeat2 :: Infinite Bool+zipWith6Repeat2 = I.zipWith6 (\x y z t u v -> y == fromIntegral (x + z + t + u + v)) zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros++zipWith6Repeat3 :: Infinite Bool+zipWith6Repeat3 = I.zipWith6 (\x y z t u v -> z == fromIntegral (x + y + t + u + v)) zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros++zipWith6Repeat4 :: Infinite Bool+zipWith6Repeat4 = I.zipWith6 (\x y z t u v -> t == fromIntegral (x + y + z + u + v)) zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros++zipWith6Repeat5 :: Infinite Bool+zipWith6Repeat5 = I.zipWith6 (\x y z t u v -> u == fromIntegral (x + y + z + t + v)) zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros++zipWith6Repeat6 :: Infinite Bool+zipWith6Repeat6 = I.zipWith6 (\x y z t u v -> v == fromIntegral (x + y + z + t + u)) zeros zeros zeros zeros zeros (I.repeat (1 :: Int))++zipWith7Repeat1 :: Infinite Bool+zipWith7Repeat1 = I.zipWith7 (\x y z t u v w -> x == fromIntegral (y + z + t + u + v + w)) (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros zeros++zipWith7Repeat2 :: Infinite Bool+zipWith7Repeat2 = I.zipWith7 (\x y z t u v w -> y == fromIntegral (x + z + t + u + v + w)) zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros zeros++zipWith7Repeat3 :: Infinite Bool+zipWith7Repeat3 = I.zipWith7 (\x y z t u v w -> z == fromIntegral (x + y + t + u + v + w)) zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros zeros++zipWith7Repeat4 :: Infinite Bool+zipWith7Repeat4 = I.zipWith7 (\x y z t u v w -> t == fromIntegral (x + y + z + u + v + w)) zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros zeros++zipWith7Repeat5 :: Infinite Bool+zipWith7Repeat5 = I.zipWith7 (\x y z t u v w -> u == fromIntegral (x + y + z + t + v + w)) zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros zeros++zipWith7Repeat6 :: Infinite Bool+zipWith7Repeat6 = I.zipWith7 (\x y z t u v w -> v == fromIntegral (x + y + z + t + u + w)) zeros zeros zeros zeros zeros (I.repeat (1 :: Int)) zeros++zipWith7Repeat7 :: Infinite Bool+zipWith7Repeat7 = I.zipWith7 (\x y z t u v w -> w == fromIntegral (x + y + z + t + u + v)) zeros zeros zeros zeros zeros zeros (I.repeat (1 :: Int))++main :: IO ()+main = defaultMain $ testGroup "All"+ [ $(inspectTest $ 'foldrMap `hasNoType` ''Word)+ , $(inspectTest $ 'foldrConsMap `hasNoType` ''Word)+ , $(inspectTest $ 'mapMap `hasNoType` ''Word)+ , $(inspectTest $ 'mapId `hasNoType` ''Word)+ , $(inspectTest $ 'mapCoerce ==- 'mapId)+ , $(inspectTest $ 'headIterate `hasNoType` ''Infinite)+ , $(inspectTest $ 'foldrIterate `hasNoType` ''Infinite)+ , $(inspectTest $ 'foldrIterate' `hasNoType` ''Infinite)+ , $(inspectTest $ 'foldrRepeat `hasNoType` ''Infinite)+ , $(inspectTest $ 'headFilterIterate `hasNoType` ''Infinite)+ , $(inspectTest $ 'filterFilter ==- 'filterFilter')+ , $(inspectTest $ 'foldrScanl `hasNoType` ''Word)+ , $(inspectTest $ 'foldrScanl' `hasNoType` ''Word)+ , $(inspectTest $ 'takeRepeat `hasNoType` ''Infinite)+ , $(inspectTest $ 'takeDropRepeat `hasNoType` ''Infinite)+ , $(inspectTest $ 'takeWhileIterate `hasNoType` ''Infinite)+ , $(inspectTest $ 'takeWhileDropWhileIterate `hasNoType` ''Infinite)+ , $(inspectTest $ 'foldrCycle `hasNoType` ''Infinite)+ , $(inspectTest $ 'foldrWordsCycle `hasNoType` ''NonEmpty)+ , $(inspectTest $ 'mapAccumLRepeat `hasNoType` ''Word)++ , $(inspectTest $ 'takeFilterIterate `hasNoType` ''Infinite)+ , $(inspectTest $ 'sumTakeFilterIterate `hasNoTypes` [''Infinite, ''[]])+ , $(inspectTest $ 'takeFilterCycle `hasNoType` ''Infinite)+ , $(inspectTest $ 'takeFilterEllipsis3 `hasNoType` ''Infinite)+ , $(inspectTest $ 'takeFilterEllipsis4 `hasNoType` ''Infinite)+ , $(inspectTest $ 'sumTakeFilterEllipsis3 `hasNoTypes` [''Infinite, ''[]])+ , $(inspectTest $ 'sumTakeFilterEllipsis4 `hasNoTypes` [''Infinite, ''[]])++ , $(inspectTest $ 'takeToListFilterIterate `hasNoType` ''Infinite)+ , $(inspectTest $ 'sumTakeToListFilterIterate `hasNoTypes` [''Infinite, ''[]])+ , $(inspectTest $ 'takeToListFilterCycle `hasNoType` ''Infinite)+ , $(inspectTest $ 'takeToListFilterEllipsis3 `hasNoType` ''Infinite)+ , $(inspectTest $ 'takeToListFilterEllipsis4 `hasNoType` ''Infinite)+ , $(inspectTest $ 'sumTakeToListFilterEllipsis3 `hasNoTypes` [''Infinite, ''[]])+ , $(inspectTest $ 'sumTakeToListFilterEllipsis4 `hasNoTypes` [''Infinite, ''[]])++ , $(inspectTest $ 'headFilterMapEllipsis3 `hasNoTypes` [''Infinite, ''[]])+ , $(inspectTest $ 'headFilterMapEllipsis4 `hasNoTypes` [''Infinite, ''[]])+ , $(inspectTest $ 'toListConcatRepeat `hasNoType` ''Infinite)+ , $(inspectTest $ 'toListConcatMapRepeat `hasNoType` ''Infinite)+ , $(inspectTest $ 'toListIntersperseRepeat `hasNoType` ''Infinite)+ , $(inspectTest $ 'toListIntercalateRepeat `hasNoType` ''Infinite)+ , $(inspectTest $ 'headMapZipIterate `hasNoType` ''Word)+ , $(inspectTest $ 'headMapFlipZipIterate `hasNoType` ''Int)++ , $(inspectTest $ 'zipWithRepeat1 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWithRepeat2 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith3Repeat1 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith3Repeat2 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith3Repeat3 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith4Repeat1 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith4Repeat2 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith4Repeat3 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith4Repeat4 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith5Repeat1 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith5Repeat2 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith5Repeat3 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith5Repeat4 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith5Repeat5 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith6Repeat1 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith6Repeat2 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith6Repeat3 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith6Repeat4 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith6Repeat5 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith6Repeat6 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith7Repeat1 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith7Repeat2 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith7Repeat3 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith7Repeat4 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith7Repeat5 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith7Repeat6 `hasNoType` ''Int)+ , $(inspectTest $ 'zipWith7Repeat7 `hasNoType` ''Int)+ ]++invertResult :: TestTree -> TestTree+invertResult = wrapTest (fmap change)+ where+ change r+ | resultSuccessful r+ = r { resultOutcome = Failure TestFailed, resultShortDescription = "FAIL" }+ | otherwise+ = r { resultOutcome = Success, resultShortDescription = "OK", resultDescription = "" }
+ test/Properties.hs view
@@ -0,0 +1,472 @@+-- |+-- Copyright: (c) 2022 Bodigrim+-- Licence: BSD3++{-# LANGUAGE PostfixOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use <$>" #-}+{-# HLINT ignore "Monad law, left identity" #-}+{-# HLINT ignore "Monad law, right identity" #-}++module Main where++import Test.QuickCheck.Function+import Test.Tasty+import Test.Tasty.QuickCheck as QC++import Control.Applicative+import Control.Monad+import Data.Bifunctor+import qualified Data.List as L+import Data.List.Infinite (Infinite(..))+import qualified Data.List.Infinite as I+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe+import Numeric.Natural++instance Arbitrary a => Arbitrary (Infinite a) where+ arbitrary = (:<) <$> arbitrary <*> arbitrary+ shrink = const []++instance Arbitrary a => Arbitrary (NonEmpty a) where+ arbitrary = (:|) <$> arbitrary <*> arbitrary++trim :: Infinite a -> [a]+trim = I.take 10++trim1 :: Infinite a -> [a]+trim1 = I.take 11++mapMapFusion :: Infinite Int -> Infinite Int+mapMapFusion xs = I.map fromIntegral (I.map fromIntegral xs :: Infinite Word)++main :: IO ()+main = defaultMain $ testGroup "All"+ [ testProperty "head" $+ \(Blind (xs :: Infinite Int)) ->+ I.head xs == L.head (trim xs)+ , testProperty "tail" $+ \(Blind (xs :: Infinite Int)) ->+ trim (I.tail xs) == L.tail (trim1 xs)+ , testProperty "uncons" $+ \(Blind (xs :: Infinite Int)) ->+ Just (fmap trim (I.uncons xs)) == L.uncons (trim1 xs)++ , testProperty "map" $+ \(applyFun -> f :: Int -> Word) (Blind (xs :: Infinite Int)) ->+ trim (I.map f xs) == L.map f (trim xs)++ , testProperty "fmap" $+ \(applyFun -> f :: Int -> Int) (Blind (xs :: Infinite Int)) ->+ trim (fmap f xs) == fmap f (trim xs)+ , testProperty "<$" $+ \(x :: Word) (Blind (xs :: Infinite Int)) ->+ trim (x <$ xs) == trim (fmap (const x) xs)++ , testProperty "pure" $+ \(applyFun -> f :: Int -> Word) (x :: Int) ->+ trim (pure f <*> pure x) == trim (pure (f x))+ , testProperty "*>" $+ \(Blind (xs :: Infinite Int)) (Blind (ys :: Infinite Word)) ->+ trim (xs *> ys) == trim ((id <$ xs) <*> ys)+ , testProperty "<*" $+ \(Blind (xs :: Infinite Int)) (Blind (ys :: Infinite Word)) ->+ trim (xs <* ys) == trim (liftA2 const xs ys)++ , testProperty ">>= 1" $+ \x ((I.cycle .) . applyFun -> k :: Int -> Infinite Word) ->+ trim (return x >>= k) == trim (k x)+ , testProperty ">>= 2" $+ \(Blind (xs :: Infinite Int)) ->+ trim (xs >>= return) == trim xs+ , testProperty ">>= 3" $+ \(Blind xs) ((I.cycle .) . applyFun -> k :: Int -> Infinite Word) ((I.cycle .) . applyFun -> h :: Word -> Infinite Char) ->+ trim (xs >>= (k >=> h)) == trim ((xs >>= k) >>= h)+ , testProperty ">>" $+ \(Blind (xs :: Infinite Int)) (Blind (ys :: Infinite Word)) ->+ trim (xs >> ys) == trim ys++ , testProperty "concat" $+ \(Blind (xs :: Infinite (NonEmpty Int))) ->+ trim (I.concat xs) == L.take 10 (L.concatMap NE.toList (I.toList xs))+ , testProperty "concatMap" $+ \(applyFun -> f :: Int -> NonEmpty Word) (Blind xs) ->+ trim (I.concatMap f xs) == L.take 10 (L.concatMap (NE.toList . f) (I.toList xs))++ , testProperty "intersperse" $+ \(x :: Int) (Blind xs) ->+ I.take 19 (I.intersperse x xs) == L.intersperse x (trim xs)+ , testProperty "intersperse laziness 1" $+ I.head (I.intersperse undefined ('q' :< undefined)) == 'q'+ , testProperty "intersperse laziness 2" $+ I.take 2 (I.intersperse 'w' ('q' :< undefined)) == "qw"++ , testProperty "intercalate" $+ \(x :: NonEmpty Int) (Blind xs) ->+ I.take (sum (map length (trim xs)) + 9 * length x) (I.intercalate x xs) == L.intercalate (NE.toList x) (trim xs)+ , testProperty "intercalate laziness 1" $+ I.take 3 (I.intercalate undefined ("foo" :< undefined)) == "foo"+ , testProperty "intercalate laziness 2" $+ I.take 6 (I.intercalate (NE.fromList "bar") ("foo" :< undefined)) == "foobar"++ , testProperty "interleave 1" $+ \(Blind (xs :: Infinite Int)) (Blind ys) ->+ trim (I.map snd (I.filter fst (I.zip (I.cycle (True :| [False])) (I.interleave xs ys)))) == trim xs+ , testProperty "interleave 2" $+ \(Blind (xs :: Infinite Int)) (Blind ys) ->+ trim (I.map snd (I.filter fst (I.zip (I.cycle (False :| [True])) (I.interleave xs ys)))) == trim ys+ , testProperty "interleave laziness" $+ I.head (I.interleave ('a' :< undefined) undefined) == 'a'++ , testProperty "transpose []" $+ \(fmap getBlind -> xss :: [Infinite Int]) -> not (null xss) ==>+ trim (I.transpose xss) == L.transpose (map trim xss)+ , testProperty "transpose NE" $+ \(fmap getBlind -> xss :: NonEmpty (Infinite Int)) ->+ NE.fromList (trim (I.transpose xss)) == NE.transpose (NE.map (NE.fromList . trim) xss)+ , testProperty "transpose laziness 1" $+ I.head (I.transpose ['a' :< undefined, 'b' :< undefined]) == "ab"+ , testProperty "transpose laziness 2" $+ I.head (I.transpose (('a' :< undefined) :| ['b' :< undefined])) == 'a' :| "b"++ , testProperty "subsequences" $+ \(Blind (xs :: Infinite Int)) ->+ I.take 16 (I.subsequences xs) == L.subsequences (I.take 4 xs)+ , testProperty "subsequences laziness 1" $+ I.head (I.subsequences undefined) == ""+ , testProperty "subsequences laziness 2" $+ I.take 2 (I.subsequences ('q' :< undefined)) == ["", "q"]++ , testProperty "permutations" $+ \(Blind (xs :: Infinite Int)) ->+ map (I.take 4) (I.take 24 (I.permutations xs)) == L.permutations (I.take 4 xs)+ , testProperty "permutations laziness" $+ I.take 6 (I.map (I.take 3) (I.permutations ('q' :< 'w' :< 'e' :< undefined))) == ["qwe","wqe","ewq","weq","eqw","qew"]++ , testProperty "... Bool" $+ \(x :: Bool) ->+ trim (x I....) === L.take 10 (L.cycle [x..])+ , testProperty "... Int" $+ \(x :: Int) ->+ trim (x I....) == L.take 10 (L.cycle [x..])+ , testProperty "... Int maxBound" $+ \(NonNegative (x' :: Int)) -> let x = maxBound - x' in+ trim (x I....) == L.take 10 (L.cycle [x..])+ , testProperty "... Word" $+ \(x :: Word) ->+ trim (x I....) == L.take 10 (L.cycle [x..])+ , testProperty "... Word maxBound" $+ \(NonNegative (x' :: Word)) -> let x = maxBound - x' in+ trim (x I....) == L.take 10 (L.cycle [x..])+ , testProperty "... Integer" $+ \(x :: Integer) ->+ trim (x I....) == L.take 10 (L.cycle [x..])+ , testProperty "... Natural" $+ \(NonNegative (x' :: Integer)) -> let x = fromInteger x' :: Natural in+ trim (x I....) == L.take 10 (L.cycle [x..])++ , testProperty ".... Bool" $+ \(x :: Bool) y ->+ trim ((x, y) I.....) == L.take 10 (L.cycle [x, y..])+ , testProperty ".... Int" $+ \(x :: Int) y ->+ trim ((x, y) I.....) == L.take 10 (L.cycle [x, y..]) .&&.+ trim ((maxBound + x, y) I.....) == L.take 10 (L.cycle [maxBound + x, y..]) &&+ trim ((x, maxBound + y) I.....) == L.take 10 (L.cycle [x, maxBound + y..]) &&+ trim ((maxBound + x, maxBound + y) I.....) == L.take 10 (L.cycle [maxBound + x, maxBound + y..])+ , testProperty ".... Word" $+ \(x :: Word) y ->+ trim ((x, y) I.....) == L.take 10 (L.cycle [x, y..]) .&&.+ trim ((maxBound + x, y) I.....) == L.take 10 (L.cycle [maxBound + x, y..]) &&+ trim ((x, maxBound + y) I.....) == L.take 10 (L.cycle [x, maxBound + y..]) &&+ trim ((maxBound + x, maxBound + y) I.....) == L.take 10 (L.cycle [maxBound + x, maxBound + y..])+ , testProperty ".... Integer" $+ \(x :: Integer) y ->+ trim ((x, y) I.....) == L.take 10 (L.cycle [x, y..])+ , testProperty ".... Natural" $+ \(NonNegative (x' :: Integer)) (NonNegative (y' :: Integer)) ->+ let x = fromInteger x' :: Natural in let y = fromInteger y' in+ trim ((x, y) I.....) == L.take 10 (L.cycle [x, y..])++ , testProperty "toList" $+ \(Blind (xs :: Infinite Int)) ->+ L.take 10 (I.toList xs) == trim xs++ , testProperty "scanl" $+ \(curry . applyFun -> f :: Word -> Int -> Word) s (Blind xs) ->+ trim1 (I.scanl f s xs) == L.scanl f s (trim xs)+ , testProperty "scanl laziness" $+ I.head (I.scanl undefined 'q' undefined) == 'q'+ , testProperty "scanl'" $+ \(curry . applyFun -> f :: Word -> Int -> Word) s (Blind xs) ->+ trim1 (I.scanl' f s xs) == L.scanl' f s (trim xs)+ , testProperty "scanl' laziness" $+ I.head (I.scanl' undefined 'q' undefined) == 'q'+ , testProperty "scanl1" $+ \(curry . applyFun -> f :: Int -> Int -> Int) (Blind xs) ->+ trim (I.scanl1 f xs) == L.scanl1 f (trim xs)+ , testProperty "scanl1 laziness" $+ I.head (I.scanl1 undefined ('q' :< undefined)) == 'q'++ , testProperty "mapAccumL" $+ \(curry . applyFun -> f :: Bool -> Int -> (Bool, Word)) (Blind xs) ->+ trim (I.mapAccumL f False xs) == snd (L.mapAccumL f False (trim xs))+ , testProperty "mapAccumL laziness" $+ I.head (I.mapAccumL (\_ x -> (undefined, x)) undefined ('q' :< undefined)) == 'q'++ , testProperty "iterate" $+ \(applyFun -> f :: Int -> Int) s ->+ trim (I.iterate f s) == L.take 10 (L.iterate f s)+ , testProperty "iterate laziness" $+ I.head (I.iterate undefined 'q') == 'q'+ , testProperty "iterate'" $+ \(applyFun -> f :: Int -> Int) s ->+ trim (I.iterate' f s) == L.take 10 (L.iterate f s)+ , testProperty "iterate' laziness" $+ I.head (I.iterate' undefined 'q') == 'q'++ , testProperty "repeat" $+ \(s :: Int) ->+ trim (I.repeat s) == L.replicate 10 s++ , testProperty "cycle" $+ \(xs :: NonEmpty Int) ->+ trim (I.cycle xs) == L.take 10 (L.cycle (NE.toList xs))+ , testProperty "cycle laziness" $+ I.head (I.cycle ('q' :| undefined)) == 'q'++ , testProperty "unfoldr" $+ \(applyFun -> f :: Word -> (Int, Word)) s ->+ trim (I.unfoldr f s) == L.take 10 (L.unfoldr (Just . f) s)+ , testProperty "unfoldr laziness" $+ I.head (I.unfoldr (, undefined) 'q') == 'q'++ , testProperty "take" $+ \n (Blind (xs :: Infinite Int)) ->+ L.take 10 (I.take n xs) == L.take n (trim xs)+ , testProperty "take laziness 1" $+ I.take 0 undefined == ""+ , testProperty "take laziness 2" $+ I.take 1 ('q' :< undefined) == "q"+ , testProperty "drop" $+ \n (Blind (xs :: Infinite Int)) ->+ trim (I.drop n xs) == L.drop n (I.take (max n 0 + 10) xs)+ , testProperty "splitAt" $+ \n (Blind (xs :: Infinite Int)) ->+ bimap (L.take 10) trim (I.splitAt n xs) ==+ first (L.take 10) (L.splitAt n (I.take (max n 0 + 10) xs))+ , testProperty "splitAt laziness 1" $+ fst (I.splitAt 0 undefined) == ""+ , testProperty "splitAt laziness 2" $+ fst (I.splitAt 1 ('q' :< undefined)) == "q"++ , testProperty "takeWhile" $+ \(applyFun -> f :: Ordering -> Bool) (Blind xs) ->+ let ys = L.take 10 (I.takeWhile f xs) in+ L.take 10 (L.takeWhile f (I.take (length ys + 10) xs)) ==+ L.take 10 (I.takeWhile f xs)+ , testProperty "takeWhile laziness 1" $+ L.null (I.takeWhile (const False) ('q' :< undefined))+ , testProperty "takeWhile laziness 2" $+ L.head (I.takeWhile (const True) ('q' :< undefined)) == 'q'+ , testProperty "fst . span" $+ \(applyFun -> f :: Ordering -> Bool) (Blind xs) ->+ let ys = L.take 10 (fst (I.span f xs)) in+ L.take 10 (L.takeWhile f (I.take (length ys + 10) xs)) ==+ L.take 10 (fst (I.span f xs))+ , testProperty "fst . break" $+ \(applyFun -> f :: Ordering -> Bool) (Blind xs) ->+ let ys = L.take 10 (fst (I.break f xs)) in+ L.take 10 (L.takeWhile (not . f) (I.take (length ys + 10) xs)) ==+ L.take 10 (fst (I.break f xs))+ , testProperty "dropWhile" $+ \(applyFun -> f :: Ordering -> Bool) (Blind xs) ->+ trim (L.foldr (:<) (I.dropWhile f xs) (I.takeWhile f xs)) == trim xs+ , testProperty "snd . span" $+ \(applyFun -> f :: Ordering -> Bool) (Blind xs) ->+ trim (L.foldr (:<) (snd (I.span f xs)) (I.takeWhile f xs)) == trim xs+ , testProperty "snd . break" $+ \(applyFun -> f :: Ordering -> Bool) (Blind xs) ->+ trim (L.foldr (:<) (snd (I.break f xs)) (I.takeWhile (not . f) xs)) == trim xs+ , testProperty "span laziness" $+ L.head (fst (I.span (/= '\n') ('q' :< undefined))) == 'q'+ , testProperty "break laziness" $+ L.head (fst (I.break (== '\n') ('q' :< undefined))) == 'q'++ , testProperty "stripPrefix" $+ \(xs :: [Int]) (Blind (ys :: Infinite Int)) ->+ fmap trim (I.stripPrefix xs ys) == fmap (L.take 10) (L.stripPrefix xs (I.take (length xs + 10) ys))+ , testProperty "stripPrefix laziness 1" $+ isNothing (I.stripPrefix ('q' : undefined) ('w' :< undefined))+ , testProperty "stripPrefix laziness 2" $+ isJust (I.stripPrefix "foo" ('f' :< 'o' :< 'o' :< undefined))+ , testProperty "isPrefixOf" $+ \(xs :: [Int]) (Blind (ys :: Infinite Int)) ->+ I.isPrefixOf xs ys == L.isPrefixOf xs (I.take (length xs + 10) ys)+ , testProperty "isPrefixOf laziness 1" $+ not (I.isPrefixOf ('q' : undefined) ('w' :< undefined))+ , testProperty "isPrefixOf laziness 2" $+ I.isPrefixOf "foo" ('f' :< 'o' :< 'o' :< undefined)++ , testProperty "zip" $+ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) ->+ trim (I.zip xs1 xs2) == L.zip (trim xs1) (trim xs2)+ , testProperty "zip3" $+ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) ->+ trim (I.zip3 xs1 xs2 xs3) == L.zip3 (trim xs1) (trim xs2) (trim xs3)+ , testProperty "zip4" $+ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) ->+ trim (I.zip4 xs1 xs2 xs3 xs4) == L.zip4 (trim xs1) (trim xs2) (trim xs3) (trim xs4)+ , testProperty "zip5" $+ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) (Blind (xs5 :: Infinite Ordering)) ->+ trim (I.zip5 xs1 xs2 xs3 xs4 xs5) == L.zip5 (trim xs1) (trim xs2) (trim xs3) (trim xs4) (trim xs5)+ , testProperty "zip6" $+ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) (Blind (xs5 :: Infinite Ordering)) (Blind (xs6 :: Infinite String)) ->+ trim (I.zip6 xs1 xs2 xs3 xs4 xs5 xs6) == L.zip6 (trim xs1) (trim xs2) (trim xs3) (trim xs4) (trim xs5) (trim xs6)+ , testProperty "zip7" $+ \(Blind (xs1 :: Infinite Int)) (Blind (xs2 :: Infinite Word)) (Blind (xs3 :: Infinite Bool)) (Blind (xs4 :: Infinite Char)) (Blind (xs5 :: Infinite Ordering)) (Blind (xs6 :: Infinite String)) (Blind (xs7 :: Infinite Integer)) ->+ trim (I.zip7 xs1 xs2 xs3 xs4 xs5 xs6 xs7) == L.zip7 (trim xs1) (trim xs2) (trim xs3) (trim xs4) (trim xs5) (trim xs6) (trim xs7)++ , testProperty "unzip" $+ \(Blind (xs :: Infinite (Int, Word))) ->+ bimap trim trim (I.unzip xs) == L.unzip (trim xs)+ , testProperty "unzip3" $+ \(Blind (xs :: Infinite (Int, Word, Bool))) ->+ (\(xs1, xs2, xs3) -> (trim xs1, trim xs2, trim xs3)) (I.unzip3 xs) == L.unzip3 (trim xs)+ , testProperty "unzip4" $+ \(Blind (xs :: Infinite (Int, Word, Bool, Char))) ->+ (\(xs1, xs2, xs3, xs4) -> (trim xs1, trim xs2, trim xs3, trim xs4)) (I.unzip4 xs) == L.unzip4 (trim xs)+ , testProperty "unzip5" $+ \(Blind (xs :: Infinite (Int, Word, Bool, Char, Ordering))) ->+ (\(xs1, xs2, xs3, xs4, xs5) -> (trim xs1, trim xs2, trim xs3, trim xs4, trim xs5)) (I.unzip5 xs) == L.unzip5 (trim xs)+ , testProperty "unzip6" $+ \(Blind (xs :: Infinite (Int, Word, Bool, Char, Ordering, String))) ->+ (\(xs1, xs2, xs3, xs4, xs5, xs6) -> (trim xs1, trim xs2, trim xs3, trim xs4, trim xs5, trim xs6)) (I.unzip6 xs) == L.unzip6 (trim xs)+ , testProperty "unzip7" $+ \(Blind (xs :: Infinite (Int, Word, Bool, Char, Ordering, String, Integer))) ->+ (\(xs1, xs2, xs3, xs4, xs5, xs6, xs7) -> (trim xs1, trim xs2, trim xs3, trim xs4, trim xs5, trim xs6, trim xs7)) (I.unzip7 xs) == L.unzip7 (trim xs)++ , testProperty "lines" $+ \(Blind (xs :: Infinite Char)) ->+ I.take 3 (I.lines xs) == L.take 3 (L.lines (I.foldr (:) xs))+ , testProperty "lines laziness 1" $+ L.head (I.head (I.lines ('q' :< undefined))) == 'q'+ , testProperty "lines laziness 2" $+ L.null (I.head (I.lines ('\n' :< undefined)))+ , testProperty "words" $+ \(Blind (xs :: Infinite Char)) ->+ I.take 3 (I.map NE.toList (I.words xs)) == L.take 3 (L.words (I.foldr (:) xs))+ , testProperty "words laziness" $+ NE.head (I.head (I.words ('q' :< undefined))) == 'q'+ , testProperty "unlines" $+ \(Blind (xs :: Infinite [Char])) ->+ trim (I.unlines xs) == L.take 10 (L.unlines (trim xs))+ , testProperty "unlines laziness" $+ I.take 2 (I.unlines ("q" :< undefined)) == "q\n"+ , testProperty "unwords" $+ \(Blind (xs :: Infinite (NonEmpty Char))) ->+ trim (I.unwords xs) == L.take 10 (L.unwords (L.map NE.toList (trim xs)))+ , testProperty "unwords laziness" $+ I.take 2 (I.unwords (('q' :| []) :< undefined)) == "q "++ , testProperty "group" $+ \(Blind (ys :: Infinite Ordering)) ->+ trim (I.group ys) == L.take 10 (NE.group (I.foldr (:) ys))+ , testProperty "group laziness" $+ NE.head (I.head (I.group ('q' :< undefined))) == 'q'+ , testProperty "nub" $+ \(Blind (ys :: Infinite (Large Int))) ->+ I.take 3 (I.nub ys) == L.take 3 (L.nub (I.foldr (:) ys))+ , testProperty "nub laziness" $+ I.head (I.nub ('q' :< undefined)) == 'q'++ , testProperty "delete" $+ \(x :: Ordering) (Blind xs) ->+ trim (I.delete x xs) == L.take 10 (L.delete x (I.foldr (:) xs))+ , testProperty "delete laziness" $+ I.head (I.delete 'q' ('w' :< undefined)) == 'w'+ , testProperty "insert" $+ \(x :: Int) (Blind xs) ->+ trim (I.insert x xs) == L.take 10 (L.insert x (I.foldr (:) xs))+ , testProperty "insert laziness" $+ I.take 2 (I.insert 'q' ('w' :< undefined)) == "qw"++ , testProperty "\\\\" $+ \(Blind (xs :: Infinite Ordering)) ys ->+ trim (xs I.\\ ys) == L.take 10 (I.foldr (:) xs L.\\ ys)+ , testProperty "\\\\ laziness" $+ I.head (('q' :< undefined) I.\\ []) == 'q'+ , testProperty "union" $+ \xs (Blind (ys :: Infinite Ordering)) ->+ I.take 3 (I.union xs ys) == L.take 3 (xs `L.union` I.foldr (:) ys)+ , testProperty "union laziness" $+ I.head (I.union ('q' : undefined) undefined) == 'q'+ , testProperty "intersect" $+ \(Blind (xs :: Infinite Ordering)) ys -> not (null ys) ==>+ I.head (I.intersect xs ys) == L.head (I.foldr (:) xs `L.intersect` ys)+ , testProperty "intersect laziness" $+ I.head (I.intersect ('q' :< undefined) ('q' : undefined)) == 'q'++ , testProperty "inits" $+ \(Blind (xs :: Infinite Int)) ->+ I.take 21 (I.inits xs) == L.inits (I.take 20 xs)+ , testProperty "inits laziness 1" $+ L.null (I.head (I.inits undefined))+ , testProperty "inits laziness 2" $+ I.take 2 (I.inits ('q' :< undefined)) == ["", "q"]+ , testProperty "inits1" $+ \(Blind (xs :: Infinite Int)) ->+ map NE.toList (trim (I.inits1 xs)) == L.tail (L.inits (trim xs))+ , testProperty "tails" $+ \(Blind (xs :: Infinite Int)) ->+ map trim (trim (I.tails xs)) === map (L.take 10) (L.take 10 (L.tails (I.take 20 xs)))+ , testProperty "tails laziness" $+ I.head (I.head (I.tails ('q' :< undefined))) == 'q'++ , testProperty "lookup" $+ \(xs :: [(Int, Word)]) y zs ->+ let pairs = NE.fromList (xs ++ (y : zs)) in+ Just (I.lookup (fst y) (I.cycle pairs)) == L.lookup (fst y) (NE.toList pairs)+ , testProperty "lookup laziness" $+ I.lookup True ((True, 'q') :< undefined) == 'q'+ , testProperty "find" $+ \(xs :: [(Int, Word)]) y zs ->+ let pairs = NE.fromList (xs ++ (y : zs)) in+ Just (I.find ((== snd y) . snd) (I.cycle pairs)) == L.find ((== snd y) . snd) (NE.toList pairs)+ , testProperty "find laziness" $+ I.find odd (1 :< undefined) == (1 :: Int)++ , testProperty "filter" $+ \(applyFun -> f :: Int -> Bool) xs (Blind ys) ->+ let us = L.filter f xs in+ us == I.take (length us) (I.filter f (I.prependList xs ys))+ , testProperty "partition" $+ \(applyFun -> f :: Int -> Bool) xs (Blind ys) ->+ let (us, vs) = L.partition f xs in+ let (us', vs') = I.partition f (I.prependList xs ys) in+ us == I.take (length us) us' && vs == I.take (length vs) vs'++ , testProperty "!!" $+ \(Blind (xs :: Infinite Int)) n ->+ xs I.!! n == I.foldr (:) xs L.!! fromIntegral n+ , testProperty "tabulate" $+ \(applyFun -> f :: Word -> Char) n ->+ I.tabulate f I.!! n == f n++ , testProperty "elemIndex" $+ \xs (x :: Int) (Blind ys) ->+ let zs = I.prependList xs (x :< ys) in+ Just (fromIntegral (I.elemIndex x zs)) == L.elemIndex x (I.foldr (:) zs)+ , testProperty "elemIndices" $+ \xs (x :: Ordering) (Blind ys) ->+ let zs = I.prependList xs (x :< ys) in+ let is = L.elemIndices x (xs ++ [x]) in+ map fromIntegral (I.take (length is) (I.elemIndices x zs)) == is+ ]