{-# OPTIONS_GHC -fglasgow-exts #-} -- | A module designed for intensive work with lists, emphasizing @fold/build@ optimization and chunking into blocks. -- /WARNING/: This module exports a number of nonstandard @fold/build@ rules on standard "Data.List" functions, -- including 'scanl', 'scanl1', 'scanr', 'scanr1', 'tails', 'unfoldr', 'mapAccumR', and 'mapAccumL'. These optimizations -- significantly improve the performance of "Data.RangeMin", but they have not been checked on whether or not they -- preserve the strictness of the original functions. Use caution when importing this module, and please notify the -- author of any issues found. module Data.RangeMin.Internal.HandyList (splitEvery) where import GHC.Exts(build) import Data.Maybe(fromJust) import Data.List {-# INLINE splitEvery #-} -- | @splitEvery n l@ is equivalent to @map (take n) (takeWhile (not . null) (iterate (drop n) l))@, so -- -- @splitEvery n [x1,x2,..,xm] = [[x1,x2,..,x(n-1)],[xn,x(n+1),..,x(2n-1)],..,[..xm]]@ -- -- It is a good producer in the @fold/build@ sense, but not a good consumer; the author believes -- this is unavoidable. splitEvery :: Int -> [e] -> [[e]] splitEvery i l = map (take i) $ build (splitter l) where splitter [] _ n = n splitter l c n = l `c` splitter (drop i l) c n {-# NOINLINE [0] unfoldrFB #-} unfoldrFB :: (b -> Maybe (a, b)) -> b -> (a -> c -> c) -> c -> c unfoldrFB g x c n = unfoldr' x where unfoldr' = maybe n (\ (a, y) -> a `c` unfoldr' y) . g {-# NOINLINE [0] scanlFB #-} scanlFB :: (a -> b -> a) -> a -> [b] -> (a -> c -> c) -> c -> c scanlFB f x ls c n = scanl' ls x where scanl' (l:ls) x = x `c` scanl' ls (f x l) scanl' [] _ = n {-# NOINLINE [0] tailerFB #-} tailerFB :: ([a] -> b -> b) -> a -> ([a], b) -> ([a], b) tailerFB c = \ x (h, l) -> let xh = x:h in (xh, xh `c` l) {-# NOINLINE [0] scanl1FB #-} scanl1FB :: (a -> a -> a) -> [a] -> (a -> b -> b) -> b -> b scanl1FB f (l:ls) c n = scanner l ls where scanner x (y:ys) = x `c` scanner (f x y) ys scanner x [] = x `c` n scanl1FB _ [] _ n = n {-# INLINE [1] mebbe #-} mebbe :: (a -> b -> a) -> a -> Maybe b -> Maybe a mebbe f x = Just . maybe x (f x) {-# NOINLINE [0] scanrFB #-} scanrFB :: (a -> b -> b) -> (b -> c -> c) -> a -> (b, c) -> (b, c) scanrFB f c = \ x (b, bs) -> let b' = f x b in (b', b' `c` bs) {-# NOINLINE [0] scanr1FB #-} scanr1FB :: (a -> a -> a) -> (a -> b -> b) -> a -> (Maybe a, b) -> (Maybe a, b) scanr1FB f c = \ x (y, m) -> let Just fxy = mebbe f x y in (Just fxy, fxy `c` m) {-# INLINE [0] mapAccumLFB #-} mapAccumLFB :: (a -> b -> (a, c)) -> (c -> d -> d) -> [b] -> a -> d -> d mapAccumLFB f c = accumulator where accumulator [] _ t = t accumulator (l:ls) x t = let (x', a) = f x l in accumulator ls x' (a `c` t) -- only for use when the second component is all that's needed {-# INLINE [0] mapAccumRFB #-} mapAccumRFB :: (a -> b -> (a, c)) -> (c -> d -> d) -> b -> (a, d) -> (a, d) mapAccumRFB f c = \ x (z, t) -> let (z', a) = f z x in (z', a `c` t) -- don't bother to transform back into mapAccumR {-# RULES "scanl" [~1] forall f x l . scanl f x l = build (scanlFB f x l); "scanlList" [1] forall f l x . build (scanlFB f x l) = scanl f x l; "tails" [~1] forall l . tails l = build (\c n -> snd (foldr (tailerFB c) ([], [] `c` n) l)); "tailsList" [1] forall l . foldr (tailerFB (:)) ([], [[]]) l = (l, tails l); "scanl1" [~1] forall f l . scanl1 f l = build (scanl1FB f l); "scanl1List" [1] forall f l . scanl1FB f l (:) [] = scanl1 f l; "foldr1" [~1] forall f l . foldr1 f l = fromJust (foldr (mebbe f) Nothing l); "foldr1List" [1] forall f l . foldr (mebbe f) Nothing l = Just (foldr1 f l); "scanr" [~1] forall f x l . scanr f x l = build (\c n -> snd (foldr (scanrFB f c) (x, n) l)); "scanrList" [1] forall f x l . snd (foldr (scanrFB f (:)) (x, []) l) = scanr f x l; "scanr1" [~1] forall f l . scanr1 f l = build (\c n -> snd (foldr (scanr1FB f c) (Nothing, n) l)); "scanr1List" [1] forall f l . snd (foldr (scanr1FB f (:)) (Nothing, []) l) = scanr1 f l; "unfoldr" [~1] forall g x . unfoldr g x = build (unfoldrFB g x); "unfoldrList" [1] forall g x . build (unfoldrFB g x) = unfoldr g x; "snd/mapAccumR" [~1] forall f z l . snd (foldr (mapAccumRFB f (:)) (z, []) l) = build (\c n -> snd (foldr (mapAccumRFB f c) (z, n) l)); "mapAccumR" [~1] forall f z . mapAccumR f z = foldr (mapAccumRFB f (:)) (z, []); "snd/mapAccumL" [~1] forall f z l . snd (mapAccumL f z l) = build (\c n -> mapAccumLFB f c l z n) #-}