DPutils 0.0.1.0 → 0.1.1.0
raw patch · 29 files changed
Files
- DPutils.cabal +92/−57
- Data/Char/Util.hs +0/−16
- Data/Paired/Common.hs +0/−29
- Data/Paired/Foldable.hs +0/−121
- Data/Paired/Vector.hs +0/−46
- Data/Vector/Generic/Unstream.hs +0/−36
- Math/TriangularNumbers.hs +0/−78
- Pipes/Parallel.hs +0/−60
- Pipes/Split/ByteString.hs +0/−140
- README.md +1/−1
- changelog.md +19/−0
- lib/DP/Backtraced/Core.hs +78/−0
- lib/Data/Attoparsec/ByteString/Streaming.hs +42/−0
- lib/Data/ByteString/Streaming/Split.hs +60/−0
- lib/Data/Char/Util.hs +16/−0
- lib/Data/Info.hs +24/−0
- lib/Data/Ord/Fast.hs +46/−0
- lib/Data/Paired/Common.hs +29/−0
- lib/Data/Paired/Foldable.hs +121/−0
- lib/Data/Paired/Vector.hs +46/−0
- lib/Data/Vector/Generic/Unstream.hs +36/−0
- lib/Math/TriangularNumbers.hs +78/−0
- lib/Pipes/Parallel.hs +60/−0
- lib/Pipes/Split/ByteString.hs +140/−0
- lib/Streaming/Primitive.hs +16/−0
- tests/QuickCheck.hs +203/−0
- tests/SmallCheck.hs +31/−0
- tests/properties.hs +15/−202
- tests/streaming.hs +55/−0
DPutils.cabal view
@@ -1,20 +1,21 @@+Cabal-version: 2.2 Name: DPutils-Version: 0.0.1.0-License: BSD3+Version: 0.1.1.0+License: BSD-3-Clause License-file: LICENSE Maintainer: choener@bioinf.uni-leipzig.de-author: Christian Hoener zu Siederdissen, 2016-copyright: Christian Hoener zu Siederdissen, 2016+author: Christian Hoener zu Siederdissen, 2016-2021+copyright: Christian Hoener zu Siederdissen, 2016-2021 homepage: https://github.com/choener/DPutils bug-reports: https://github.com/choener/DPutils/issues Stability: Experimental Category: Data Build-type: Simple-Cabal-version: >=1.10.0-tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1+tested-with: GHC == 8.8, GHC == 8.10, GHC == 9.0 Synopsis: utilities for DP Description:- Small set of utility functions+ Small set of utility functions, as well as the base types for+ generic backtracing. . @@ -25,32 +26,44 @@ -Library- Exposed-modules:- Data.Char.Util- Data.Paired.Common- Data.Paired.Foldable- Data.Paired.Vector- Data.Vector.Generic.Unstream- Math.TriangularNumbers- Pipes.Parallel- Pipes.Split.ByteString- build-depends: base >= 4.7 && < 5.0+common deps+ build-depends: base >= 4.7 && < 5.0+ , attoparsec >= 0.13 , bytestring , containers- , kan-extensions >= 4.0- , parallel >= 3.0- , pipes >= 4.0- , QuickCheck >= 2.7- , stringsearch >= 0.3- , transformers >= 0.5- , vector >= 0.10+ , kan-extensions >= 4.0+ , lens >= 4.0+ , mtl+ , parallel >= 3.0+ , pipes >= 4.0+ , pipes-bytestring >= 2.0+ , pipes-parse >= 3.0+ , primitive >= 0.6+ , QuickCheck >= 2.7+ , smallcheck >= 1.1+ , streaming >= 0.1+ , streaming-bytestring >= 0.1+ , stringsearch >= 0.3+ , transformers >= 0.5+ , vector >= 0.10 default-extensions: BangPatterns , CPP+ , DeriveGeneric+ , DeriveFunctor+ , DeriveFoldable+ , DeriveTraversable+ , FlexibleContexts+ , FlexibleInstances+ , GADTs+ , LambdaCase+ , MultiParamTypeClasses , RankNTypes , ScopedTypeVariables+ , TemplateHaskell+ , TypeApplications , TypeFamilies- , FlexibleContexts+ , UndecidableInstances+ , UnicodeSyntax default-language: Haskell2010 ghc-options:@@ -58,59 +71,81 @@ -funbox-strict-fields +Library+ import: deps+ Exposed-modules:+ Data.Attoparsec.ByteString.Streaming+ Data.ByteString.Streaming.Split+ Data.Char.Util+ Data.Info+ Data.Ord.Fast+ Data.Paired.Common+ Data.Paired.Foldable+ Data.Paired.Vector+ Data.Vector.Generic.Unstream+ DP.Backtraced.Core+ Math.TriangularNumbers+ Pipes.Parallel+ Pipes.Split.ByteString+ Streaming.Primitive+ hs-source-dirs:+ lib ++ test-suite properties+ import:+ deps+ build-depends: base+ , tasty >= 0.11+ , tasty-quickcheck >= 0.8+ , tasty-smallcheck >= 0.8+ , tasty-th >= 0.1+ --+ , DPutils type: exitcode-stdio-1.0 main-is: properties.hs+ other-modules:+ QuickCheck+ SmallCheck ghc-options:- -O2 -threaded -rtsopts -with-rtsopts=-N+ -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests- default-language:- Haskell2010- default-extensions: CPP- , RankNTypes- , ScopedTypeVariables- , TemplateHaskell- build-depends: base- , bytestring- , containers- , kan-extensions- , lens >= 4.0- , mtl- , parallel- , pipes- , pipes-bytestring >= 2.0- , pipes-parse >= 3.0- , QuickCheck- , quickcheck-instances >= 0.3- , tasty >= 0.11- , tasty-quickcheck >= 0.8- , tasty-th >= 0.1- , vector- --- , DPutils benchmark benchmark+ import: deps+ build-depends: base+ , criterion >= 1.1 type: exitcode-stdio-1.0- build-depends: base- , criterion >= 1.1- , vector- --- , DPutils+ build-depends:+ DPutils hs-source-dirs: tests main-is: benchmark.hs++++benchmark streaming+ import: deps+ type:+ exitcode-stdio-1.0+ build-depends: DPutils+ , timeit >= 2.0+ hs-source-dirs:+ tests+ main-is:+ streaming.hs default-language: Haskell2010 ghc-options:- -O2+ -O2 -rtsopts "-with-rtsopts=-K10M -M10M"
− Data/Char/Util.hs
@@ -1,16 +0,0 @@---- | Convert between @Word8@ and @Char@. Mostly for attoparsec's bytestring--- module.--module Data.Char.Util where--import Data.Word (Word8)--c2w8 :: Char -> Word8-c2w8 = fromIntegral . fromEnum-{-# Inline c2w8 #-}--w82c :: Word8 -> Char-w82c = toEnum . fromIntegral-{-# Inline w82c #-}-
− Data/Paired/Common.hs
@@ -1,29 +0,0 @@--module Data.Paired.Common where------ | Shall we combine elements on the main diagonal as well?------ If we choose @NoDiag@, we deal with upper triangular matrices that are--- effectively one element smaller.--data OnDiag = OnDiag | NoDiag- deriving (Eq)---- | Select only a subset of the possible enumerations.--data Enumerate- -- | Enumerate all elements- = All- -- | Enumerate from a value and at most @N@ elements- | FromN Int Int- deriving (Eq)---- | If the size of the input is known before-hand or not.--data SizeHint- = UnknownSize- | KnownSize Int- deriving (Eq)-
− Data/Paired/Foldable.hs
@@ -1,121 +0,0 @@---- | Efficient enumeration of subsets of triangular elements. Given a list--- @[1..n]@ we want to enumerate a subset @[(i,j)]@ of ordered pairs in--- such a way that we only have to hold the elements necessary for this--- subset in memory.--module Data.Paired.Foldable where--import Data.IntMap as IM-import Data.Foldable as F-import Data.List as L-import Control.Arrow ((***))-import Data.Vector as V-import Data.Vector.Generic as VG-import Debug.Trace (traceShow)-import Text.Printf--import Data.Paired.Common-import Math.TriangularNumbers------ | Generalized upper triangular elements. Given a list of elements--- @[e_1,...,e_k]@, we want to return pairs @(e_i,e_j)@ such that we have--- all ordered pairs with @i<j@ (if @NoDiag@onal elements), or @i<=j@ (if--- @OnDiag@onal elements).------ @upperTri@ will force the spine of @t a@ but is consumed linearly with--- a strict @Data.Foldable.foldl'@. Internally we keep a @Data.IntMap@ of--- the retained elements.------ This is important if the @Enumerate@ type is set to @FromN k n@. We--- start at the @k@th element, and produce @n@ elements.------ TODO compare @IntMap@ and @HashMap@.------ TODO inRange is broken.--upperTri- :: (Foldable t)- => SizeHint- -- ^ If the size of @t a@ is known beforehand, give the appropriate- -- @KnownSize n@, otherwise give @UnknownSize@. Using @UnknownSize@ will- -- force the complete spine of @t a@.- -> OnDiag- -- ^ The enumeration will include the pairs on the main diagonal with- -- @OnDiag@, meaning @(i,i)@ will be included for all @i@. Otherwise,- -- @NoDiag@ will exclude these elements.- -> Enumerate- -- ^ Either enumerate @All@ elements or enumerate the @s@ elements- -- starting at @k@ with @FromN k s@.- -> t a- -- ^ The foldable data structure to enumerate over.- -> Either String (IntMap a, Int, [((Int,Int),(a,a))])- -- ^ If there is any error then return @Left errorMsg@. Otherwise we have- -- @Right (imap, numElems, list)@. The @imap@ structure holds the subset- -- of elements with which we actually generate elements. @numElems@ is- -- the total number of elements that will be generated. This is- -- calculated without touch @list@. Finally, @list@ is the lazy list of- -- elements to be generated.-upperTri sz d e xs- | szLen /= readLen = Left $ printf "Expected SizeHint %d elements, but processed only %d elements!" szLen readLen- | otherwise = Right (imp, numElems, ys)- where ys = case e of {All -> id ; FromN _ s -> L.take s}- . L.unfoldr go $ initEnum e d- -- how many elements we will emit depends on enumeration and on- -- diagonal element counting- numElems- | All <- e = allSize- | FromN s k <- e = if s+k > allSize then max 0 (allSize - s) else k- -- The length of the input. With a given size hint, @xs :: t a@- -- will only be touched once.-#if MIN_VERSION_base(4,8,0)- szLen = case sz of { UnknownSize -> F.length xs ; KnownSize z -> z }-#else- szLen = case sz of { UnknownSize -> L.length . F.toList $ xs ; KnownSize z -> z }-#endif- szLn' = case d of { OnDiag -> szLen - 1 ; NoDiag -> szLen - 2 }- -- Construct an intmap @imp@ of all elements in the accepted range.- -- At the same time, return the length or size of the foldable- -- container we gave as input. @xs@ is touched only once and can- -- be efficiently consumed.- (!imp,!readLen) = F.foldl' (\(!i,!l) x -> (if inRange l then IM.insert l x i else i,l+1)) (IM.empty, 0) xs- allSize = szLen * (szLen + if d == OnDiag then 1 else -1) `div` 2- -- we need three ranges. @cMin@ and @cMax@ are the range for the- -- slow-moving first element in the tuple. @rMin@ and @rMax@ are- -- the first and last element of the range starting at @cMin@ (we- -- can actually start at @cMax@ but it doesn't matter).- -- Finally, @lMin@ and @lMax@ are the range to the left of @cMin@.- (lMin,lMax,cMin,cMax,rMin,rMax) = case e of- All -> (0, szLen-1, 0, szLen-1, 0, szLen-1)- FromN s k ->- let (cmin,rmin) = fromLinear szLn' s- (cmax,_ ) = fromLinear szLn' (s+k)- rmax = rmin+k -- if this is @>= len@ we are safe anyway.- lmin = if rmin+k >= szLen then 0 else cmin- lmax = if rmin+k >= szLen then lmin + toLinear szLn' (cmin+1,cmin+1+rmin+k-szLn') else cmax- in (lmin, lmax, cmin, cmax, rmin, rmax)- -- Determine if an element at linear index @z@ is in the range to- -- be consumed.- inRange z = lMin <= z && z <= lMax- || cMin <= z && z <= cMax- || rMin <= z && z <= rMax- -- index into the generated vector @xs@ when generating elements- -- via @go@- go (k,l)- | k >= szLen = Nothing- | l >= szLen = go (k+1,k+1 + if d == OnDiag then 0 else 1)- | otherwise = Just (((k,l),(imp IM.! k, imp IM.! l)), (k,l+1))- -- Initialize the enumeration at the correct pair @(i,j)@. From- -- then on we can @take@ the correct number of elements, or stream- -- all of them.- initEnum All OnDiag = (0,0)- initEnum All NoDiag = (0,1)- initEnum (FromN s k) OnDiag- | s >= allSize = (szLen,szLen)- | otherwise = fromLinear szLn' s- initEnum (FromN s k) NoDiag- | s >= allSize = (szLen,szLen)- | otherwise = id *** (+1) $ fromLinear szLn' s-
− Data/Paired/Vector.hs
@@ -1,46 +0,0 @@--module Data.Paired.Vector- ( module Data.Paired.Vector- , module Data.Paired.Common- ) where--import Data.Vector.Generic as VG--import Data.Paired.Common------ | Upper triangular elements.--upperTriVG- :: (Vector v a, Vector w (a,a))- => OnDiag- -> v a- -> (Int, w (a,a))-upperTriVG d as = (z, unfoldrN z go (0,if d == OnDiag then 0 else 1))- where la = VG.length as- z = la * (la + if d == OnDiag then 1 else 0) `div` 2- go (k,l)- | k >= la = Nothing- | l >= la = go (k+1,k+1 + if d == OnDiag then 0 else 1)- | otherwise = Just ((as `VG.unsafeIndex` k, as `VG.unsafeIndex` l), (k,l+1))-{-# Inline upperTriVG #-}---- | Outer pairing of all @as@ with all @bs@. This one is quasi-trivial,--- but here for completeness.--rectangularVG- :: (Vector va a, Vector vb b, Vector w (a,b))- => va a- -> vb b- -> (Int, w (a,b))-rectangularVG as bs = (z, unfoldrN z go (0,0))- where la = VG.length as- lb = VG.length bs- z = la * lb- go (k,l)- | k >= la = Nothing- | l >= lb = go (k+1,0)- | otherwise = Just ((as `VG.unsafeIndex` k, bs `VG.unsafeIndex` l), (k,l+1))-{-# Inline rectangularVG #-}-
− Data/Vector/Generic/Unstream.hs
@@ -1,36 +0,0 @@---- | Helper functions for turnings streams into vectors.------ Mostly very similar to bundle conversion functions from the @vector@--- package.--module Data.Vector.Generic.Unstream where--import Control.Monad.ST-import GHC.Conc (pseq)-import qualified Data.Vector.Fusion.Stream.Monadic as SM-import qualified Data.Vector.Generic as VG-import qualified Data.Vector.Generic.Mutable as VGM-import System.IO.Unsafe (unsafePerformIO)---- for testing--import qualified Data.Vector.Unboxed as VU------ | Turns a stream into a vector.------ TODO insert index checks? Generalized @flag devel@--streamToVectorM :: forall m v a . (Monad m, VG.Vector v a) => SM.Stream m a -> m (v a)-streamToVectorM s = do- let mv' = unsafePerformIO $ VGM.unsafeNew 1- let put (v',i) x =- do let v = unsafePerformIO $ if (i < VGM.length v') then return v' else VGM.unsafeGrow v' (max 1 $ VGM.length v')- seq (unsafePerformIO $ VGM.unsafeWrite v i x) (return (v,i+1))- {-# Inline [0] put #-}- (mv,written) <- SM.foldlM' put (mv',0) s- mv `pseq` return . unsafePerformIO . VG.freeze $ VGM.unsafeSlice 0 written mv-{-# Inline streamToVectorM #-}-
− Math/TriangularNumbers.hs
@@ -1,78 +0,0 @@---- | Triangular numbers and various helper functions.------ Main use is for linearization of triangular array indexing.--- --- Triangular numbers:--- @--- T_n = Σ_{k=1)^n k = 1 + 2 + 3 + ... + n =------ n * (n+1) / 2 = (n+1) `choose` 2--- @--------module Math.TriangularNumbers where------ | Triangular numbers.------ https://oeis.org/A000217--triangularNumber :: Int -> Int-triangularNumber x = (x * (x+1)) `quot` 2-{-# INLINE triangularNumber #-}---- | Size of an upper triangle starting at 'i' and ending at 'j'. "(0,N)" what--- be the normal thing to use.--linearizeUppertri :: (Int,Int) -> Int-linearizeUppertri (i,j) = triangularNumber $ j-i+1-{-# INLINE linearizeUppertri #-}---- | Subword indexing. Given the longest subword and the current subword,--- calculate a linear index "[0,..]". "(l,n)" in this case means "l"ower bound,--- length "n". And "(i,j)" is the normal index.------ @--- 0 1 2 3 <- j = ...------ 0 1 2 3 i=0--- _ 4 5 6 i=1--- _ _ 7 8 i=2--- 9 i=3------ i=2, j=3 -> (4+1) * i - tri i + j------ _--- _ _ the triangular number to subtract.--- @--toLinear :: Int -> (Int,Int) -> Int-toLinear n (i,j) = adr n (i,j)- where- adr n (i,j) = (n+1)*i - triangularNumber i + j- {-# Inline adr #-}-{-# INLINE toLinear #-}------ | Linear index to paired.------ We have indices in @[0,N]@, and linear index @k@.------ @--- (N+1)*i - (i*(i+1)/2) + j == K--- @--fromLinear :: Int -> Int -> (Int,Int)-fromLinear n' k' = (i,j)- where ll = (2*n+1) / 2- rr = sqrt $ ((2*(n+1)+1) / 2)^2 - 2*k- n = fromIntegral n'- k = fromIntegral k'- i = floor $ ll - rr + 1- j = k' - toLinear n' (i,0)-{-# Inline fromLinear #-}-
− Pipes/Parallel.hs
@@ -1,60 +0,0 @@---- | Pipes that introduce parallelism on different levels.--module Pipes.Parallel where--import Control.Monad.Codensity (lowerCodensity)-import Control.Monad (replicateM)-import Control.Parallel.Strategies (Strategy, parMap)-import Pipes------ | Evaluates chunks of pipes elements in parallel with a pure function.--pipePar- :: (Monad m)- => Int- -- ^ number of elements to evaluate in parallel- -> Strategy b- -- ^ with which strategy- -> (a -> b)- -- ^ function to be mapped in parallel- -> Pipe a b m ()-pipePar n strat f = pipeParBA n strat f (\as -> return ((),as)) (\() bs -> return bs)-{-- where- go = do- xs <- lowerCodensity . replicateM n $ lift await- let ys = parMap strat f xs- lowerCodensity $ mapM_ (lift . yield) ys- go--}---- | Evaluates chunks of pipes elements in parallel with a pure function.--- Before and after each parallel step, a monadic function is run. This--- allows generation of certain statistics or information during runs.--pipeParBA- :: (Monad m)- => Int- -- ^ number of elements to evaluate in parallel- -> Strategy b- -- ^ with which strategy- -> (a -> b)- -- ^ pure function to run in parallel- -> ([a] -> m (x,[a]))- -- ^ function to run before- -> (x -> [b] -> m [b])- -- ^ function to run after- -> Pipe a b m ()-pipeParBA n strat f bef aft = go- where- go = do- as' <- lowerCodensity . replicateM n $ lift await- (x,as) <- lift $ bef as'- let bs' = parMap strat f as- bs <- lift $ aft x bs'- lowerCodensity $ mapM_ (lift . yield) bs- go-
− Pipes/Split/ByteString.hs
@@ -1,140 +0,0 @@---- | Split incombing bytestrings based on bytestrings.--module Pipes.Split.ByteString where--import Control.Monad (join,unless)-import Control.Monad.Trans.Class (lift)-import Data.ByteString (ByteString)-import Data.ByteString.Search (indices)-import Data.Monoid ((<>))-import Debug.Trace-import Pipes (Producer,next,yield)-import qualified Data.ByteString as BS----type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)---- | Splits bytestrings after each pattern @pat@. Tries to minimize the--- number of intermediate bytestring constructors.------ The following function @ske@ expects a string @str@ and a pattern @pat@--- and then returns a tuple with the splitted bytestrings in @fst@ and the--- return value in @snd@.------ The inner parser @parse@ uses @zoom@ to draw the full inner producer,--- which should contain just one bytestring, namely one of the split off--- ones. @parse@ doesn't do anything with the inner producer, except--- returning the contained bytestring.------ @parse@ returns @Right $ concat xs@ on a correct parse, and @Left []@--- once the input has been exhausted.------ @--- ske :: ByteString -> ByteString -> ([ByteString],[ByteString],[ByteString])--- ske pat str | BS.null pat || BS.null str = ([],[],[])--- ske pat str =--- let parse = do--- xs <- zoom (splitKeepEnd pat) PP.drawAll--- case xs of--- [] -> return $ Left []--- xs -> return $ Right $ BS.concat xs--- (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PP.yield str--- in (a,b, fst . runIdentity . P.toListM' $ p)--- @--splitKeepEnd :: Monad m => ByteString -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))-splitKeepEnd pat k p0 = fmap join (k (go BS.empty p0)) where- go pre p = do- x <- lift (next p)- case x of- Left r -> return $ return r- Right (bs, p') -> do- case fnd (pre <> bs) of- -- no hit yet, send the bs down, keep some suffix- [] -> do- unless (BS.null bs) (yield bs)- let pfx = BS.drop (BS.length bs - l + 1) bs- go pfx p'- -- at least one hit, split off the correct part, remainder goes- -- back.- (k:_) -> do- let (y,suf) = BS.splitAt (k - BS.length pre + l) bs- yield y- return (yield suf >> p')- l = BS.length pat- fnd = indices pat-{-# Inlineable splitKeepEnd #-}------ | Split a string into substrings, where each substring starts with @pat@--- and continues until just before the next @pat@ (or until there is no--- more input).------ Any prefix that does not start with the substring is /kept/!------ Since each substring is supposed to start with @pat@, there is a small--- problem. What about a header that prefixes the string we are interested--- in?--splitKeepStart :: Monad m => ByteString -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))-splitKeepStart = splitGeneric (\bs k p l -> BS.splitAt (k - p) bs)-{-# Inlineable splitKeepStart #-}------ | Generic splitting function. Takes a bytestring @[a,b,c]@ (where--- @a,b,c@ are substrings of the bytestring!) and performs the split.-----splitGeneric- :: Monad m- => (ByteString -> Int -> Int -> Int -> (ByteString,ByteString))- -- ^ splitter function- -> ByteString- -- ^ pattern to split on- -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))- -- ^ lens into the individual split off bytestrings-splitGeneric splt pat k p0 = fmap join (k (go BS.empty p0)) where- go pre p = do- x <- lift (next p)- case x of- Left r -> do- -- yield final split off string- unless (BS.null pre) (yield pre)- return $ return r- Right (bs, p') -> do- -- will not search in the part of the prefix that *can not contain*- -- the @pat@tern.- case fnd ((BS.drop (BS.length pre - l) pre) <> bs) of- -- no hit yet, send the prefix down completely, make bs new- -- prefix if possible. If either @pre@ or @bs@ are too short, we- -- keep @pre <> bs@ for the next round. This should not happen if- -- the pattern is reasonably short compared to the size of the- -- bytestring chunks.- [] -> do- if (BS.length bs >= l)- then yield pre >> go bs p'- else go (pre <> bs) p'- -- at least one hit, split off the correct part, remainder goes- -- back.- (k:_) -> do- let (y,suf) = splt bs k (BS.length pre) l- yield y- return (yield suf >> p')- l = BS.length pat- fnd = indices pat-{-# Inline splitGeneric #-}------ manual splitting, for @splitKeepEnd@--referenceByteStringTokenizer pat str | BS.null pat || BS.null str = []-referenceByteStringTokenizer pat str- = (h `BS.append` BS.take (BS.length pat) t)- : if BS.null t then [] else referenceByteStringTokenizer pat (BS.drop (BS.length pat) t)- where (h,t) = BS.breakSubstring pat str-
README.md view
@@ -1,4 +1,4 @@-[](https://travis-ci.org/choener/DPutils)+ # DPutils
changelog.md view
@@ -1,3 +1,22 @@+0.1.1.0+-------++- Data.Ord.Fast provides fast versions of min/max (until GHC catches up)+- Data.Info for "hand-written" Show-like instances to be used in an interactive environment. The+ info might, for example, return the length, beginning, and end of a string.++0.1.0.0+-------++- DP.Backtraced.Core provide a "core" system for backtraces in DP algorithms,+ splitting out individual tapes++0.0.2.0+-------++- Data.ByteString.Streaming.Split with generic splitting operations for the+ bytestring-streaming library+ 0.0.1.0 -------
+ lib/DP/Backtraced/Core.hs view
@@ -0,0 +1,78 @@++-- | The base constructors for generic backtracing.+--+-- NOTE this currently can capture dot-bracket notation, but not deep+-- semantics.++module DP.Backtraced.Core where++import Control.Lens+import Data.Foldable+import GHC.Generics (Generic)+import qualified Data.Sequence as Seq+import qualified Test.QuickCheck as QC+import qualified Test.SmallCheck.Series as SC++-- | This is a bit like a lazy "Data.Sequence" in terms of constructors. We can+-- not be spine-strict, otherwise we'd use @Data.Sequence@ and enjoy the better+-- performance.++data Backtraced ty where+ -- | This backtrace is done+ Epsilon ∷ Backtraced ty+ -- | Expand a backtrace to the left. This is lazy, since backtracing relies+ -- on laziness.+ Cons ∷ ty → Backtraced ty → Backtraced ty+ -- | Expand lazily to the right.+ Snoc ∷ Backtraced ty → ty → Backtraced ty+ -- | concatenate two structures+ Append ∷ Backtraced ty → Backtraced ty → Backtraced ty+ deriving (Eq,Ord,Show,Read,Generic,Functor,Foldable,Traversable)++-- | This is somewhat tricky, since we might have to walk down the structure+-- quite a bit and shuffle constructors without changing the actual leaf order.++instance Cons (Backtraced ty) (Backtraced ty') ty ty' where+ {-# Inlinable _Cons #-}+ _Cons =+ let go1 Epsilon = Left Epsilon+ go1 (Cons x xs) = Right (x,xs)+ go1 (Snoc xs x) = go2 xs (Left x)+ go1 (Append xs ys) = go2 xs (Right ys)+ go2 Epsilon (Left y) = Right (y,Epsilon)+ go2 Epsilon (Right ys) = go1 ys+ go2 (Cons x xs) (Left y) = Right (x,Snoc xs y)+ go2 (Cons x xs) (Right ys) = Right (x, Append xs ys)+ go2 (Snoc xs x) (Left y) = go2 xs (Right $ x `Cons` Epsilon `Snoc` y)+ go2 (Snoc xs x) (Right ys) = go2 xs (Right $ x `Cons` ys)+ go2 (Append xs ys) (Left z) = go2 xs (Right $ ys `Snoc` z)+ go2 (Append xs ys) (Right zs) = go2 xs (Right $ ys `Append` zs)+ in prism (uncurry Cons) go1++instance Snoc (Backtraced ty) (Backtraced ty') ty ty' where+ {-# Inlinable _Snoc #-}+ _Snoc =+ let go1 Epsilon = Left Epsilon+ go1 (Cons x xs) = go2 (Left x) xs+ go1 (Snoc xs x) = Right (xs,x)+ go1 (Append xs ys) = go2 (Right xs) ys+ go2 (Left x) Epsilon = Right (Epsilon,x)+ go2 (Right xs) Epsilon = go1 xs+ go2 (Left x) (Cons y ys) = go2 (Right $ x `Cons` (y `Cons` Epsilon)) ys+ go2 (Right xs) (Cons y ys) = go2 (Right $ xs `Snoc` y) ys+ go2 (Left x) (Snoc ys y) = Right (x `Cons` ys, y)+ go2 (Right xs) (Snoc ys y) = Right (xs `Append` ys, y)+ go2 (Left x) (Append ys zs) = go2 (Right $ x `Cons` ys) zs+ go2 (Right xs) (Append ys zs) = go2 (Right $ xs `Append` ys) zs+ in prism (uncurry Snoc) go1++(<|) = Cons+(|>) = Snoc+(><) = Append++infixr 5 <|+infixr 5 ><+infixl 5 |>++instance SC.Serial m a ⇒ SC.Serial m (Backtraced a)+
+ lib/Data/Attoparsec/ByteString/Streaming.hs view
@@ -0,0 +1,42 @@++-- | Taken from Michael Thompson <http://hackage.haskell.org/package/streaming-utils>++module Data.Attoparsec.ByteString.Streaming where++import qualified Data.Attoparsec.ByteString as A+import Data.ByteString.Streaming+import Data.ByteString.Streaming.Internal+import qualified Data.ByteString as B+import Streaming.Internal (Stream (..)) +import Streaming hiding (concats, unfold)++++type Message = ([String], String)++-- | The parsed function from @streaming-utils@++parsed+ :: Monad m+ => A.Parser a -- ^ Attoparsec parser+ -> ByteString m r -- ^ Raw input+ -> Stream (Of a) m (Either (Message, ByteString m r) r)+parsed parser = begin+ where+ begin p0 = case p0 of -- inspect for null chunks before+ Go m -> lift m >>= begin -- feeding attoparsec + Empty r -> Return (Right r)+ Chunk bs p1 | B.null bs -> begin p1+ | otherwise -> step (chunk bs >>) (A.parse parser bs) p1+ step diffP res p0 = case res of+ A.Fail _ c m -> Return (Left ((c,m), diffP p0))+ A.Done bs a | B.null bs -> Step (a :> begin p0) + | otherwise -> Step (a :> begin (chunk bs >> p0))+ A.Partial k -> do+ x <- lift (nextChunk p0)+ case x of+ Left e -> step diffP (k mempty) (return e)+ Right (bs,p1) | B.null bs -> step diffP res p1+ | otherwise -> step (diffP . (chunk bs >>)) (k bs) p1+{-# INLINABLE parsed #-}+
+ lib/Data/ByteString/Streaming/Split.hs view
@@ -0,0 +1,60 @@++-- | Splitting functions for @ByteString m r@ into @Stream (ByteString m) m r@.+--+-- TODO These functions need quickcheck tests.++module Data.ByteString.Streaming.Split where++import Data.ByteString.Streaming.Char8 as S8+import Data.ByteString.Streaming.Internal as SI+import Streaming.Internal (Stream(..))++++-- | Split a @ByteString m r@ after every @k@ characters.+--+-- Streams in constant memory.+--+-- BUG: Once the stream is exhausted, it will still call @splitAt@, forever+-- creating empty @ByteString@s.++splitsByteStringAt ∷ Monad m ⇒ Int → ByteString m r → Stream (ByteString m) m r+splitsByteStringAt !k = loop where+ loop (Empty r) = return r+ loop p = Step $ fmap loop $ S8.splitAt (fromIntegral k) p+{- -- this version would consume all memory+ loop p = SI.Effect $ do+ e ← nextChunk p+ return $ case e of+ Left r → SI.Return r+ Right (a,p') → SI.Step (fmap loop (S8.splitAt (fromIntegral k) (chunk a >> p')))+ -}+{-# Inlinable splitsByteStringAt #-}++++-- | For lists, this would be @sbs (f :: [a] -> ([a],[a])) -> [a] -> [[a]]@.+-- Takes a function that splits the bytestring into two elements repeatedly,+-- where the first is followed by the repeated application of the function.+--+-- cf. <http://hackage.haskell.org/package/streaming-utils-0.1.4.7/docs/src/Streaming-Pipes.html#chunksOf>+--+-- TODO these functions should go into a helper library++separatesByteString+ ∷ Monad m+ ⇒ (ByteString m r → ByteString m (ByteString m r))+ → ByteString m r+ → Stream (ByteString m) m r+separatesByteString f = loop where+ loop (Empty r) = return r+ loop p = Step $ fmap loop $ f p+{-+ loop p = SI.Effect $ do+ e ← nextChunk p+ return $ case e of+ Left r → SI.Return r+ Right (a,p') → SI.Step (fmap loop (f (chunk a >> p')))+-}+{-# Inlinable separatesByteString #-}+
+ lib/Data/Char/Util.hs view
@@ -0,0 +1,16 @@++-- | Convert between @Word8@ and @Char@. Mostly for attoparsec's bytestring+-- module.++module Data.Char.Util where++import Data.Word (Word8)++c2w8 :: Char -> Word8+c2w8 = fromIntegral . fromEnum+{-# Inline c2w8 #-}++w82c :: Word8 -> Char+w82c = toEnum . fromIntegral+{-# Inline w82c #-}+
+ lib/Data/Info.hs view
@@ -0,0 +1,24 @@++-- | Similar to @Show@, this module provides a string via @info@. This string gives convenient+-- user-information on objects.++module Data.Info where++import Data.List (concat,intersperse)+import qualified Data.Vector.Unboxed as VU++++class Info c where+ -- | The string returned by 'info' should be around 60 chars per line, and one line if possible.+ info :: c -> String++instance (Info a, Info b, Info c) => Info (a,b,c) where+ info (a,b,c) = concat $ intersperse " " [info a, info b, info c]++instance (VU.Unbox a, Info a) => Info (VU.Vector a) where+ info = concatMap info . VU.toList++instance Info Int where+ info = show+
+ lib/Data/Ord/Fast.hs view
@@ -0,0 +1,46 @@++{-# Language MagicHash #-}+{-# Language ForeignFunctionInterface #-}+{-# Language UnliftedFFITypes #-}+{-# Language GHCForeignImportPrim #-}+{-# Language UnboxedTuples #-}+{-# Language CPP #-}++-- | This module provides a small set of function for extremely fast @max@ and+-- @min@ operations that are branchless.+--+-- This should be temporary, since GHC is supposed to get the branchless variants.+--+-- NOTE these do not seem to be faster anyway.++module Data.Ord.Fast where++import GHC.Exts++++class FastMinMax x where+ fastmin :: x -> x -> x+ fastmax :: x -> x -> x+ -- | Clamp values to @>=0@.+ clamp :: x -> x++instance FastMinMax Int where+ fastmin (I# x) (I# y) =+ let !xmy = x -# y+ res = I# ( y +# ( xmy `andI#` uncheckedIShiftRA# xmy 63# ) )+ in res+ {-# Inline fastmin #-}+ fastmax (I# x) (I# y) =+ let !xmy = x -# y+ res = I# ( x -# ( xmy `andI#` uncheckedIShiftRA# xmy 63# ) )+ in res+ -- FROM: https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-bignum-1.0/src/GHC-Num-Primitives.html#maxI%23+ -- NOTE: slightly slower than the above version+ --fastmax (I# x) (I# y)+ -- | isTrue# (x >=# y) = I# x+ -- | True = I# y+ {-# Inline fastmax #-}+ clamp (I# x) = I# (andI# x (notI# (uncheckedIShiftRA# x 63#)))+ {-# Inline clamp #-}+
+ lib/Data/Paired/Common.hs view
@@ -0,0 +1,29 @@++module Data.Paired.Common where++++-- | Shall we combine elements on the main diagonal as well?+--+-- If we choose @NoDiag@, we deal with upper triangular matrices that are+-- effectively one element smaller.++data OnDiag = OnDiag | NoDiag+ deriving (Eq)++-- | Select only a subset of the possible enumerations.++data Enumerate+ -- | Enumerate all elements+ = All+ -- | Enumerate from a value and at most @N@ elements+ | FromN Int Int+ deriving (Eq)++-- | If the size of the input is known before-hand or not.++data SizeHint+ = UnknownSize+ | KnownSize Int+ deriving (Eq)+
+ lib/Data/Paired/Foldable.hs view
@@ -0,0 +1,121 @@++-- | Efficient enumeration of subsets of triangular elements. Given a list+-- @[1..n]@ we want to enumerate a subset @[(i,j)]@ of ordered pairs in+-- such a way that we only have to hold the elements necessary for this+-- subset in memory.++module Data.Paired.Foldable where++import Data.IntMap as IM+import Data.Foldable as F+import Data.List as L+import Control.Arrow ((***))+import Data.Vector as V+import Data.Vector.Generic as VG+import Debug.Trace (traceShow)+import Text.Printf++import Data.Paired.Common+import Math.TriangularNumbers++++-- | Generalized upper triangular elements. Given a list of elements+-- @[e_1,...,e_k]@, we want to return pairs @(e_i,e_j)@ such that we have+-- all ordered pairs with @i<j@ (if @NoDiag@onal elements), or @i<=j@ (if+-- @OnDiag@onal elements).+--+-- @upperTri@ will force the spine of @t a@ but is consumed linearly with+-- a strict @Data.Foldable.foldl'@. Internally we keep a @Data.IntMap@ of+-- the retained elements.+--+-- This is important if the @Enumerate@ type is set to @FromN k n@. We+-- start at the @k@th element, and produce @n@ elements.+--+-- TODO compare @IntMap@ and @HashMap@.+--+-- TODO inRange is broken.++upperTri+ :: (Foldable t)+ => SizeHint+ -- ^ If the size of @t a@ is known beforehand, give the appropriate+ -- @KnownSize n@, otherwise give @UnknownSize@. Using @UnknownSize@ will+ -- force the complete spine of @t a@.+ -> OnDiag+ -- ^ The enumeration will include the pairs on the main diagonal with+ -- @OnDiag@, meaning @(i,i)@ will be included for all @i@. Otherwise,+ -- @NoDiag@ will exclude these elements.+ -> Enumerate+ -- ^ Either enumerate @All@ elements or enumerate the @s@ elements+ -- starting at @k@ with @FromN k s@.+ -> t a+ -- ^ The foldable data structure to enumerate over.+ -> Either String (IntMap a, Int, [((Int,Int),(a,a))])+ -- ^ If there is any error then return @Left errorMsg@. Otherwise we have+ -- @Right (imap, numElems, list)@. The @imap@ structure holds the subset+ -- of elements with which we actually generate elements. @numElems@ is+ -- the total number of elements that will be generated. This is+ -- calculated without touch @list@. Finally, @list@ is the lazy list of+ -- elements to be generated.+upperTri sz d e xs+ | szLen /= readLen = Left $ printf "Expected SizeHint %d elements, but processed only %d elements!" szLen readLen+ | otherwise = Right (imp, numElems, ys)+ where ys = case e of {All -> id ; FromN _ s -> L.take s}+ . L.unfoldr go $ initEnum e d+ -- how many elements we will emit depends on enumeration and on+ -- diagonal element counting+ numElems+ | All <- e = allSize+ | FromN s k <- e = if s+k > allSize then max 0 (allSize - s) else k+ -- The length of the input. With a given size hint, @xs :: t a@+ -- will only be touched once.+#if MIN_VERSION_base(4,8,0)+ szLen = case sz of { UnknownSize -> F.length xs ; KnownSize z -> z }+#else+ szLen = case sz of { UnknownSize -> L.length . F.toList $ xs ; KnownSize z -> z }+#endif+ szLn' = case d of { OnDiag -> szLen - 1 ; NoDiag -> szLen - 2 }+ -- Construct an intmap @imp@ of all elements in the accepted range.+ -- At the same time, return the length or size of the foldable+ -- container we gave as input. @xs@ is touched only once and can+ -- be efficiently consumed.+ (!imp,!readLen) = F.foldl' (\(!i,!l) x -> (if inRange l then IM.insert l x i else i,l+1)) (IM.empty, 0) xs+ allSize = szLen * (szLen + if d == OnDiag then 1 else -1) `div` 2+ -- we need three ranges. @cMin@ and @cMax@ are the range for the+ -- slow-moving first element in the tuple. @rMin@ and @rMax@ are+ -- the first and last element of the range starting at @cMin@ (we+ -- can actually start at @cMax@ but it doesn't matter).+ -- Finally, @lMin@ and @lMax@ are the range to the left of @cMin@.+ (lMin,lMax,cMin,cMax,rMin,rMax) = case e of+ All -> (0, szLen-1, 0, szLen-1, 0, szLen-1)+ FromN s k ->+ let (cmin,rmin) = fromLinear szLn' s+ (cmax,_ ) = fromLinear szLn' (s+k)+ rmax = rmin+k -- if this is @>= len@ we are safe anyway.+ lmin = if rmin+k >= szLen then 0 else cmin+ lmax = if rmin+k >= szLen then lmin + toLinear szLn' (cmin+1,cmin+1+rmin+k-szLn') else cmax+ in (lmin, lmax, cmin, cmax, rmin, rmax)+ -- Determine if an element at linear index @z@ is in the range to+ -- be consumed.+ inRange z = lMin <= z && z <= lMax+ || cMin <= z && z <= cMax+ || rMin <= z && z <= rMax+ -- index into the generated vector @xs@ when generating elements+ -- via @go@+ go (k,l)+ | k >= szLen = Nothing+ | l >= szLen = go (k+1,k+1 + if d == OnDiag then 0 else 1)+ | otherwise = Just (((k,l),(imp IM.! k, imp IM.! l)), (k,l+1))+ -- Initialize the enumeration at the correct pair @(i,j)@. From+ -- then on we can @take@ the correct number of elements, or stream+ -- all of them.+ initEnum All OnDiag = (0,0)+ initEnum All NoDiag = (0,1)+ initEnum (FromN s k) OnDiag+ | s >= allSize = (szLen,szLen)+ | otherwise = fromLinear szLn' s+ initEnum (FromN s k) NoDiag+ | s >= allSize = (szLen,szLen)+ | otherwise = id *** (+1) $ fromLinear szLn' s+
+ lib/Data/Paired/Vector.hs view
@@ -0,0 +1,46 @@++module Data.Paired.Vector+ ( module Data.Paired.Vector+ , module Data.Paired.Common+ ) where++import Data.Vector.Generic as VG++import Data.Paired.Common++++-- | Upper triangular elements.++upperTriVG+ :: (Vector v a, Vector w (a,a))+ => OnDiag+ -> v a+ -> (Int, w (a,a))+upperTriVG d as = (z, unfoldrN z go (0,if d == OnDiag then 0 else 1))+ where la = VG.length as+ z = la * (la + if d == OnDiag then 1 else 0) `div` 2+ go (k,l)+ | k >= la = Nothing+ | l >= la = go (k+1,k+1 + if d == OnDiag then 0 else 1)+ | otherwise = Just ((as `VG.unsafeIndex` k, as `VG.unsafeIndex` l), (k,l+1))+{-# Inline upperTriVG #-}++-- | Outer pairing of all @as@ with all @bs@. This one is quasi-trivial,+-- but here for completeness.++rectangularVG+ :: (Vector va a, Vector vb b, Vector w (a,b))+ => va a+ -> vb b+ -> (Int, w (a,b))+rectangularVG as bs = (z, unfoldrN z go (0,0))+ where la = VG.length as+ lb = VG.length bs+ z = la * lb+ go (k,l)+ | k >= la = Nothing+ | l >= lb = go (k+1,0)+ | otherwise = Just ((as `VG.unsafeIndex` k, bs `VG.unsafeIndex` l), (k,l+1))+{-# Inline rectangularVG #-}+
+ lib/Data/Vector/Generic/Unstream.hs view
@@ -0,0 +1,36 @@++-- | Helper functions for turnings streams into vectors.+--+-- Mostly very similar to bundle conversion functions from the @vector@+-- package.++module Data.Vector.Generic.Unstream where++import Control.Monad.ST+import GHC.Conc (pseq)+import qualified Data.Vector.Fusion.Stream.Monadic as SM+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Generic.Mutable as VGM+import System.IO.Unsafe (unsafePerformIO)++-- for testing++import qualified Data.Vector.Unboxed as VU++++-- | Turns a stream into a vector.+--+-- TODO insert index checks? Generalized @flag devel@++streamToVectorM :: forall m v a . (Monad m, VG.Vector v a) => SM.Stream m a -> m (v a)+streamToVectorM s = do+ let mv' = unsafePerformIO $ VGM.unsafeNew 1+ let put (v',i) x =+ do let v = unsafePerformIO $ if (i < VGM.length v') then return v' else VGM.unsafeGrow v' (max 1 $ VGM.length v')+ seq (unsafePerformIO $ VGM.unsafeWrite v i x) (return (v,i+1))+ {-# Inline [0] put #-}+ (mv,written) <- SM.foldlM' put (mv',0) s+ mv `pseq` return . unsafePerformIO . VG.freeze $ VGM.unsafeSlice 0 written mv+{-# Inline streamToVectorM #-}+
+ lib/Math/TriangularNumbers.hs view
@@ -0,0 +1,78 @@++-- | Triangular numbers and various helper functions.+--+-- Main use is for linearization of triangular array indexing.+-- +-- Triangular numbers:+-- @+-- T_n = Σ_{k=1)^n k = 1 + 2 + 3 + ... + n =+--+-- n * (n+1) / 2 = (n+1) `choose` 2+-- @+--+--++module Math.TriangularNumbers where++++-- | Triangular numbers.+--+-- https://oeis.org/A000217++triangularNumber :: Int -> Int+triangularNumber x = (x * (x+1)) `quot` 2+{-# INLINE triangularNumber #-}++-- | Size of an upper triangle starting at 'i' and ending at 'j'. "(0,N)" what+-- be the normal thing to use.++linearizeUppertri :: (Int,Int) -> Int+linearizeUppertri (i,j) = triangularNumber $ j-i+1+{-# INLINE linearizeUppertri #-}++-- | Subword indexing. Given the longest subword and the current subword,+-- calculate a linear index "[0,..]". "(l,n)" in this case means "l"ower bound,+-- length "n". And "(i,j)" is the normal index.+--+-- @+-- 0 1 2 3 <- j = ...+--+-- 0 1 2 3 i=0+-- _ 4 5 6 i=1+-- _ _ 7 8 i=2+-- 9 i=3+--+-- i=2, j=3 -> (4+1) * i - tri i + j+--+-- _+-- _ _ the triangular number to subtract.+-- @++toLinear :: Int -> (Int,Int) -> Int+toLinear n (i,j) = adr n (i,j)+ where+ adr n (i,j) = (n+1)*i - triangularNumber i + j+ {-# Inline adr #-}+{-# INLINE toLinear #-}++++-- | Linear index to paired.+--+-- We have indices in @[0,N]@, and linear index @k@.+--+-- @+-- (N+1)*i - (i*(i+1)/2) + j == K+-- @++fromLinear :: Int -> Int -> (Int,Int)+fromLinear n' k' = (i,j)+ where ll = (2*n+1) / 2+ rr = sqrt $ ((2*(n+1)+1) / 2)^2 - 2*k+ n = fromIntegral n'+ k = fromIntegral k'+ i = floor $ ll - rr + 1+ j = k' - toLinear n' (i,0)+{-# Inline fromLinear #-}+
+ lib/Pipes/Parallel.hs view
@@ -0,0 +1,60 @@++-- | Pipes that introduce parallelism on different levels.++module Pipes.Parallel where++import Control.Monad.Codensity (lowerCodensity)+import Control.Monad (replicateM)+import Control.Parallel.Strategies (Strategy, parMap)+import Pipes++++-- | Evaluates chunks of pipes elements in parallel with a pure function.++pipePar+ :: (Monad m)+ => Int+ -- ^ number of elements to evaluate in parallel+ -> Strategy b+ -- ^ with which strategy+ -> (a -> b)+ -- ^ function to be mapped in parallel+ -> Pipe a b m ()+pipePar n strat f = pipeParBA n strat f (\as -> return ((),as)) (\() bs -> return bs)+{-+ where+ go = do+ xs <- lowerCodensity . replicateM n $ lift await+ let ys = parMap strat f xs+ lowerCodensity $ mapM_ (lift . yield) ys+ go+-}++-- | Evaluates chunks of pipes elements in parallel with a pure function.+-- Before and after each parallel step, a monadic function is run. This+-- allows generation of certain statistics or information during runs.++pipeParBA+ :: (Monad m)+ => Int+ -- ^ number of elements to evaluate in parallel+ -> Strategy b+ -- ^ with which strategy+ -> (a -> b)+ -- ^ pure function to run in parallel+ -> ([a] -> m (x,[a]))+ -- ^ function to run before+ -> (x -> [b] -> m [b])+ -- ^ function to run after+ -> Pipe a b m ()+pipeParBA n strat f bef aft = go+ where+ go = do+ as' <- lowerCodensity . replicateM n $ lift await+ (x,as) <- lift $ bef as'+ let bs' = parMap strat f as+ bs <- lift $ aft x bs'+ lowerCodensity $ mapM_ (lift . yield) bs+ go+
+ lib/Pipes/Split/ByteString.hs view
@@ -0,0 +1,140 @@++-- | Split incombing bytestrings based on bytestrings.++module Pipes.Split.ByteString where++import Control.Monad (join,unless)+import Control.Monad.Trans.Class (lift)+import Data.ByteString (ByteString)+import Data.ByteString.Search (indices)+import Data.Monoid ((<>))+import Debug.Trace+import Pipes (Producer,next,yield)+import qualified Data.ByteString as BS++++type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)++-- | Splits bytestrings after each pattern @pat@. Tries to minimize the+-- number of intermediate bytestring constructors.+--+-- The following function @ske@ expects a string @str@ and a pattern @pat@+-- and then returns a tuple with the splitted bytestrings in @fst@ and the+-- return value in @snd@.+--+-- The inner parser @parse@ uses @zoom@ to draw the full inner producer,+-- which should contain just one bytestring, namely one of the split off+-- ones. @parse@ doesn't do anything with the inner producer, except+-- returning the contained bytestring.+--+-- @parse@ returns @Right $ concat xs@ on a correct parse, and @Left []@+-- once the input has been exhausted.+--+-- @+-- ske :: ByteString -> ByteString -> ([ByteString],[ByteString],[ByteString])+-- ske pat str | BS.null pat || BS.null str = ([],[],[])+-- ske pat str =+-- let parse = do+-- xs <- zoom (splitKeepEnd pat) PP.drawAll+-- case xs of+-- [] -> return $ Left []+-- xs -> return $ Right $ BS.concat xs+-- (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PP.yield str+-- in (a,b, fst . runIdentity . P.toListM' $ p)+-- @++splitKeepEnd :: Monad m => ByteString -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))+splitKeepEnd pat k p0 = fmap join (k (go BS.empty p0)) where+ go pre p = do+ x <- lift (next p)+ case x of+ Left r -> return $ return r+ Right (bs, p') -> do+ case fnd (pre <> bs) of+ -- no hit yet, send the bs down, keep some suffix+ [] -> do+ unless (BS.null bs) (yield bs)+ let pfx = BS.drop (BS.length bs - l + 1) bs+ go pfx p'+ -- at least one hit, split off the correct part, remainder goes+ -- back.+ (k:_) -> do+ let (y,suf) = BS.splitAt (k - BS.length pre + l) bs+ yield y+ return (yield suf >> p')+ l = BS.length pat+ fnd = indices pat+{-# Inlineable splitKeepEnd #-}++++-- | Split a string into substrings, where each substring starts with @pat@+-- and continues until just before the next @pat@ (or until there is no+-- more input).+--+-- Any prefix that does not start with the substring is /kept/!+--+-- Since each substring is supposed to start with @pat@, there is a small+-- problem. What about a header that prefixes the string we are interested+-- in?++splitKeepStart :: Monad m => ByteString -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))+splitKeepStart = splitGeneric (\bs k p l -> BS.splitAt (k - p) bs)+{-# Inlineable splitKeepStart #-}++++-- | Generic splitting function. Takes a bytestring @[a,b,c]@ (where+-- @a,b,c@ are substrings of the bytestring!) and performs the split.+--++splitGeneric+ :: Monad m+ => (ByteString -> Int -> Int -> Int -> (ByteString,ByteString))+ -- ^ splitter function+ -> ByteString+ -- ^ pattern to split on+ -> Lens' (Producer ByteString m x) (Producer ByteString m (Producer ByteString m x))+ -- ^ lens into the individual split off bytestrings+splitGeneric splt pat k p0 = fmap join (k (go BS.empty p0)) where+ go pre p = do+ x <- lift (next p)+ case x of+ Left r -> do+ -- yield final split off string+ unless (BS.null pre) (yield pre)+ return $ return r+ Right (bs, p') -> do+ -- will not search in the part of the prefix that *can not contain*+ -- the @pat@tern.+ case fnd ((BS.drop (BS.length pre - l) pre) <> bs) of+ -- no hit yet, send the prefix down completely, make bs new+ -- prefix if possible. If either @pre@ or @bs@ are too short, we+ -- keep @pre <> bs@ for the next round. This should not happen if+ -- the pattern is reasonably short compared to the size of the+ -- bytestring chunks.+ [] -> do+ if (BS.length bs >= l)+ then yield pre >> go bs p'+ else go (pre <> bs) p'+ -- at least one hit, split off the correct part, remainder goes+ -- back.+ (k:_) -> do+ let (y,suf) = splt bs k (BS.length pre) l+ yield y+ return (yield suf >> p')+ l = BS.length pat+ fnd = indices pat+{-# Inline splitGeneric #-}++++-- manual splitting, for @splitKeepEnd@++referenceByteStringTokenizer pat str | BS.null pat || BS.null str = []+referenceByteStringTokenizer pat str+ = (h `BS.append` BS.take (BS.length pat) t)+ : if BS.null t then [] else referenceByteStringTokenizer pat (BS.drop (BS.length pat) t)+ where (h,t) = BS.breakSubstring pat str+
+ lib/Streaming/Primitive.hs view
@@ -0,0 +1,16 @@++module Streaming.Primitive where++import Control.Monad.Primitive+import Streaming++++-- | Orphan instance providing a primitive monad instance for streams. Allows+-- impurely folds into mutable vectors from streams.++instance (Monad m, PrimMonad m, Functor f) ⇒ PrimMonad (Stream f m) where+ type PrimState (Stream f m) = PrimState m+ {-# Inline primitive #-}+ primitive = lift . primitive+
+ tests/QuickCheck.hs view
@@ -0,0 +1,203 @@++module QuickCheck where++import Data.List as L+import Data.Map.Strict as M+import Data.Tuple (swap)+import Data.Vector as V+import Debug.Trace+import Test.QuickCheck+import Test.Tasty.QuickCheck as QC+import Test.Tasty.TH++import Data.Paired.Foldable as DPF+import Data.Paired.Vector as DPV+import Math.TriangularNumbers++-- * Data.Paired.Vector++-- |++prop_vector_upperTri_On :: NonNegative Int -> Bool+prop_vector_upperTri_On (NonNegative k) = V.toList vs == ls+ where vs = snd $ upperTriVG OnDiag v+ ls = [ (a,b)+ | as@(a:_) <- L.init . L.tails $ V.toList v+ , b <- as+ ]+ v = V.enumFromTo 0 k++-- |++prop_vector_upperTri_No :: NonNegative Int -> Bool+prop_vector_upperTri_No (NonNegative k) = V.toList vs == ls+ where vs = snd $ upperTriVG NoDiag v+ ls = [ (a,b)+ | (a:as) <- L.init . L.tails $ V.toList v+ , b <- as+ ]+ v = V.enumFromTo 0 k++-- |++prop_vector_rectangular :: NonNegative Int -> NonNegative Int -> Bool+prop_vector_rectangular (NonNegative k) (NonNegative l) = V.toList vs == ls+ where vs = snd $ rectangularVG as bs+ ls = [ (a,b)+ | a <- V.toList as+ , b <- V.toList bs+ ]+ as = V.enumFromTo 0 k+ bs = V.enumFromTo 0 l++++-- * Data.Paired.Foldable++-- | Generalized upper triangular elements. We want to enumerate all+-- elements, including those on the main diagonal.++prop_foldable_upperTri_On_All :: (NonNegative Int, Bool) -> Bool+prop_foldable_upperTri_On_All (NonNegative n, b)+ | chk = True+ | otherwise = traceShow (ls,vs) False+ where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) OnDiag All xs+ ls = [ ((a,b),(a,b))+ | as@(a:_) <- L.init . L.tails $ xs+ , b <- as+ ]+ xs = [ 0 .. n-1 ]+ chk = vs == ls++-- | Only a subset of elements, starting at @k@ (counting from 0) and+-- taking @s@ elements.++prop_foldable_upperTri_On_FromN :: (NonNegative Int, NonNegative Int, NonNegative Int, Bool) -> Bool+prop_foldable_upperTri_On_FromN (NonNegative n, NonNegative k, NonNegative s, b)+ | chk = True+ | otherwise = traceShow (ls,vs) False+ where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) OnDiag (FromN k s) xs+ ls = L.take s+ . L.drop k+ $ [ ((a,b),(a,b))+ | as@(a:_) <- L.init . L.tails $ xs+ , b <- as+ ]+ xs = [ 0 .. n-1 ]+ chk = vs == ls++prop_foldable_upperTri_No_All :: (NonNegative Int, Bool) -> Bool+prop_foldable_upperTri_No_All (NonNegative n, b)+ | chk = True+ | otherwise = traceShow (ls,vs) False+ where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) NoDiag All xs+ ls = [ ((a,b),(a,b))+ | (a:as) <- L.init . L.tails $ xs+ , b <- as+ ]+ xs = [ 0 .. n-1 ]+ chk = vs == ls++prop_foldable_upperTri_No_FromN :: (NonNegative Int, NonNegative Int, NonNegative Int, Bool) -> Bool+prop_foldable_upperTri_No_FromN (NonNegative n, NonNegative k, NonNegative s, b)+ | chk = True+ | otherwise = traceShow (ls,vs) False+ where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) NoDiag (FromN k s) xs+ ls = L.take s+ . L.drop k+ $ [ ((a,b),(a,b))+ | (a:as) <- L.init . L.tails $ xs+ , b <- as+ ]+ xs = [ 0 .. n-1 ]+ chk = vs == ls++++-- * Math.TriangularNumbers++-- | Test that each index pair @(i,j)@ is assigned a unique linear index+-- @k@ given @0 <= i <= j <= n@.++prop_uniqueLinear :: NonNegative Int -> Bool+prop_uniqueLinear (NonNegative n) = M.null $ M.filter ((/=1) . L.length) mp+ where mp = M.fromListWith (L.++) [ (toLinear n (i,j), [(i,j)]) | i <- [0..n], j <- [i..n] ]++-- | Back and forth translation between paired and linear indices is+-- unique.++prop_BackForth :: NonNegative Int -> Bool+prop_BackForth (NonNegative n) = L.and xs+ where mb = M.fromList ls+ mf = M.fromList $ L.map swap ls+ ls = [ (toLinear n (i,j), (i,j)) | i <- [0..n], j <- [i..n] ]+ xs = [ (mb M.! k == (i,j)) && (mf M.! (i,j) == k) && fromLinear n k == (i,j)+ | (k,(i,j)) <- ls ]++--++-- | Check if both splitKeepEnd and simple tokenization provide the same+-- result.++--prop_splitKeepEndStrict :: String -> Small Int -> Small Int -> Bool+--prop_splitKeepEndStrict str' (Small k) (Small l)+-- | tt == ss = True+-- | otherwise = traceShow ("ske",pat,str,k,l,tt,ss,ee) False+-- where str = BS.concat . L.replicate skeMult $ BS.pack str'+-- -- make a small pattern with a chance that it repeats+-- pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str+-- -- what ske thinks is a good split+-- (ss,ee,_) = ske pat str+-- -- manual splitting+-- tt = referenceByteStringTokenizer pat str++-- | Check if both splitKeepEnd and simple tokenization provide the same+-- result.++--prop_splitKeepEndLazy :: String -> Small Int -> Small Int -> Bool+--prop_splitKeepEndLazy str' (Small k) (Small l)+-- | tt == ll = True+-- | otherwise = traceShow ("ske'",pat,str',str,strL,k,l,tt,ll,ee,rr) False+-- where str = BS.concat . L.replicate skeMult $ BS.pack str'+-- strL = BSL.fromChunks $ L.replicate skeMult $ BS.pack str'+-- -- make a small pattern with a chance that it repeats+-- pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str+-- -- what we get with the lazy version+-- (ll,ee,rr) = ske' pat strL+-- -- manual splitting+-- tt = referenceByteStringTokenizer pat str++-- The actual splitting system++--ske :: ByteString -> ByteString -> ([ByteString],[ByteString],[ByteString])+--ske pat str | BS.null pat || BS.null str = ([],[],[])+--ske pat str =+-- let parse = do+-- xs <- zoom (splitKeepEnd pat) PP.drawAll+-- case xs of+-- [] -> return $ Left []+-- xs -> return $ Right $ BS.concat xs+-- (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PP.yield str+-- in (a,b, fst . runIdentity . P.toListM' $ p)+--+--ske' :: ByteString -> BSL.ByteString -> ([ByteString],[ByteString],[ByteString])+--ske' pat _ | BS.null pat = ([],[],[])+--ske' pat str =+-- let parse = do+-- xs <- zoom (splitKeepEnd pat) PP.drawAll+-- case xs of+-- [] -> return $ Left []+-- xs -> return $ Right $ BS.concat xs+-- (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PB.fromLazy str+-- in (a,b, fst . runIdentity . P.toListM' $ p)++skeMult :: Int+skeMult = 1000++++-- * Streaming tests.+++testQuickCheck = $(testGroupGenerator)+
+ tests/SmallCheck.hs view
@@ -0,0 +1,31 @@++module SmallCheck where++import Control.Arrow (second)+import Control.Lens+import Data.Foldable+import Debug.Trace+import Test.SmallCheck+import Test.SmallCheck.Drivers+import Test.Tasty.SmallCheck as SC+import Test.Tasty.TH++import DP.Backtraced.Core++++-- prop_BackTraced_Cons+-- ∷ forall m+-- . ( Monad m )+-- ⇒ Proxy a → Property m++-- xprop_Backtraced_Cons ∷ Monad m ⇒ m (Maybe PropertyFailure)+prop_Backtraced_Cons = changeDepth (const 4) $+ {- smallCheckM 4 $ -} \(bt ∷ Backtraced Bool) →+ let lst = toList bt+ btC ∷ Maybe (Bool,[Bool])+ btC = fmap (second toList) $ bt^?_Cons+-- in traceShow (bt) $ traceShow (bt^?_Cons,lst^?_Cons) (btC == lst^?_Cons) -- bt^._Cons == lst^._Cons+ in btC == lst^?_Cons++testSmallCheck = $(testGroupGenerator)
tests/properties.hs view
@@ -1,213 +1,26 @@ module Main where -import Control.Lens-import Control.Monad.Identity-import Data.ByteString (ByteString)-import Data.List as L-import Data.Map.Strict as M-import Data.Tuple (swap)-import Data.Vector as V-import Debug.Trace-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy as BSL-import qualified Pipes as P-import qualified Pipes.ByteString as PB-import qualified Pipes.Parse as PP-import qualified Pipes.Prelude as P-import Test.QuickCheck-import Test.QuickCheck.Instances+--import Control.Lens+--import Control.Monad.Identity+--import Data.ByteString (ByteString)+--import qualified Data.ByteString.Char8 as BS+--import qualified Data.ByteString.Lazy as BSL+--import qualified Pipes as P+--import qualified Pipes.ByteString as PB+--import qualified Pipes.Parse as PP+--import qualified Pipes.Prelude as P import Test.Tasty-import Test.Tasty.QuickCheck as QC-import Test.Tasty.TH--import Data.Paired.Foldable as DPF-import Data.Paired.Vector as DPV-import Math.TriangularNumbers-import Pipes.Split.ByteString------ * Data.Paired.Vector---- |--prop_vector_upperTri_On :: NonNegative Int -> Bool-prop_vector_upperTri_On (NonNegative k) = V.toList vs == ls- where vs = snd $ upperTriVG OnDiag v- ls = [ (a,b)- | as@(a:_) <- L.init . L.tails $ V.toList v- , b <- as- ]- v = V.enumFromTo 0 k---- |--prop_vector_upperTri_No :: NonNegative Int -> Bool-prop_vector_upperTri_No (NonNegative k) = V.toList vs == ls- where vs = snd $ upperTriVG NoDiag v- ls = [ (a,b)- | (a:as) <- L.init . L.tails $ V.toList v- , b <- as- ]- v = V.enumFromTo 0 k---- |--prop_vector_rectangular :: NonNegative Int -> NonNegative Int -> Bool-prop_vector_rectangular (NonNegative k) (NonNegative l) = V.toList vs == ls- where vs = snd $ rectangularVG as bs- ls = [ (a,b)- | a <- V.toList as- , b <- V.toList bs- ]- as = V.enumFromTo 0 k- bs = V.enumFromTo 0 l------ * Data.Paired.Foldable---- | Generalized upper triangular elements. We want to enumerate all--- elements, including those on the main diagonal.--prop_foldable_upperTri_On_All :: (NonNegative Int, Bool) -> Bool-prop_foldable_upperTri_On_All (NonNegative n, b)- | chk = True- | otherwise = traceShow (ls,vs) False- where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) OnDiag All xs- ls = [ ((a,b),(a,b))- | as@(a:_) <- L.init . L.tails $ xs- , b <- as- ]- xs = [ 0 .. n-1 ]- chk = vs == ls---- | Only a subset of elements, starting at @k@ (counting from 0) and--- taking @s@ elements.--prop_foldable_upperTri_On_FromN :: (NonNegative Int, NonNegative Int, NonNegative Int, Bool) -> Bool-prop_foldable_upperTri_On_FromN (NonNegative n, NonNegative k, NonNegative s, b)- | chk = True- | otherwise = traceShow (ls,vs) False- where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) OnDiag (FromN k s) xs- ls = L.take s- . L.drop k- $ [ ((a,b),(a,b))- | as@(a:_) <- L.init . L.tails $ xs- , b <- as- ]- xs = [ 0 .. n-1 ]- chk = vs == ls--prop_foldable_upperTri_No_All :: (NonNegative Int, Bool) -> Bool-prop_foldable_upperTri_No_All (NonNegative n, b)- | chk = True- | otherwise = traceShow (ls,vs) False- where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) NoDiag All xs- ls = [ ((a,b),(a,b))- | (a:as) <- L.init . L.tails $ xs- , b <- as- ]- xs = [ 0 .. n-1 ]- chk = vs == ls--prop_foldable_upperTri_No_FromN :: (NonNegative Int, NonNegative Int, NonNegative Int, Bool) -> Bool-prop_foldable_upperTri_No_FromN (NonNegative n, NonNegative k, NonNegative s, b)- | chk = True- | otherwise = traceShow (ls,vs) False- where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) NoDiag (FromN k s) xs- ls = L.take s- . L.drop k- $ [ ((a,b),(a,b))- | (a:as) <- L.init . L.tails $ xs- , b <- as- ]- xs = [ 0 .. n-1 ]- chk = vs == ls------ * Math.TriangularNumbers---- | Test that each index pair @(i,j)@ is assigned a unique linear index--- @k@ given @0 <= i <= j <= n@.--prop_uniqueLinear :: NonNegative Int -> Bool-prop_uniqueLinear (NonNegative n) = M.null $ M.filter ((/=1) . L.length) mp- where mp = M.fromListWith (L.++) [ (toLinear n (i,j), [(i,j)]) | i <- [0..n], j <- [i..n] ]---- | Back and forth translation between paired and linear indices is--- unique.--prop_BackForth :: NonNegative Int -> Bool-prop_BackForth (NonNegative n) = L.and xs- where mb = M.fromList ls- mf = M.fromList $ L.map swap ls- ls = [ (toLinear n (i,j), (i,j)) | i <- [0..n], j <- [i..n] ]- xs = [ (mb M.! k == (i,j)) && (mf M.! (i,j) == k) && fromLinear n k == (i,j)- | (k,(i,j)) <- ls ]-+--import Test.Tasty.SmallCheck as SC --+--import Pipes.Split.ByteString --- | Check if both splitKeepEnd and simple tokenization provide the same--- result.+import QuickCheck+import SmallCheck -prop_splitKeepEndStrict :: String -> Small Int -> Small Int -> Bool-prop_splitKeepEndStrict str' (Small k) (Small l)- | tt == ss = True- | otherwise = traceShow ("ske",pat,str,k,l,tt,ss,ee) False- where str = BS.concat . L.replicate skeMult $ BS.pack str'- -- make a small pattern with a chance that it repeats- pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str- -- what ske thinks is a good split- (ss,ee,_) = ske pat str- -- manual splitting- tt = referenceByteStringTokenizer pat str --- | Check if both splitKeepEnd and simple tokenization provide the same--- result. -prop_splitKeepEndLazy :: String -> Small Int -> Small Int -> Bool-prop_splitKeepEndLazy str' (Small k) (Small l)- | tt == ll = True- | otherwise = traceShow ("ske'",pat,str',str,strL,k,l,tt,ll,ee,rr) False- where str = BS.concat . L.replicate skeMult $ BS.pack str'- strL = BSL.fromChunks $ L.replicate skeMult $ BS.pack str'- -- make a small pattern with a chance that it repeats- pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str- -- what we get with the lazy version- (ll,ee,rr) = ske' pat strL- -- manual splitting- tt = referenceByteStringTokenizer pat str---- The actual splitting system--ske :: ByteString -> ByteString -> ([ByteString],[ByteString],[ByteString])-ske pat str | BS.null pat || BS.null str = ([],[],[])-ske pat str =- let parse = do- xs <- zoom (splitKeepEnd pat) PP.drawAll- case xs of- [] -> return $ Left []- xs -> return $ Right $ BS.concat xs- (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PP.yield str- in (a,b, fst . runIdentity . P.toListM' $ p)--ske' :: ByteString -> BSL.ByteString -> ([ByteString],[ByteString],[ByteString])-ske' pat _ | BS.null pat = ([],[],[])-ske' pat str =- let parse = do- xs <- zoom (splitKeepEnd pat) PP.drawAll- case xs of- [] -> return $ Left []- xs -> return $ Right $ BS.concat xs- (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PB.fromLazy str- in (a,b, fst . runIdentity . P.toListM' $ p)--skeMult :: Int-skeMult = 1000- main :: IO ()-main = $(defaultMainGenerator)+main = do+ defaultMain $ testGroup "all tests" [testQuickCheck, testSmallCheck]
+ tests/streaming.hs view
@@ -0,0 +1,55 @@++-- | Test the performance of splitting and consuming a *very long* bytestring+-- using @streaming@.++module Main where++import Data.Functor.Of+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy.Char8 as BSL8+import qualified Data.ByteString.Streaming.Char8 as SB8+import System.TimeIt+import Text.Printf++import qualified Data.ByteString.Streaming.Split as SBS++++genLong+ ∷ ( Monad m )+ ⇒ Int+ → SB8.ByteString m ()+genLong = SB8.fromLazy . BSL8.fromChunks . go+ where+ -- create chunks of strict char8 bytestring to concatenate.+ go !k+ | k <= 0 = []+ | otherwise = chunk : go (k-1)+ -- the chunk to use for concatenation.+ !chunk = BS8.pack $ ['A'..'Z'] ++ "\n" ++ ['a'..'z']+{-# Inlinable genLong #-}++-- | Generate long strings, split them after every 10 characters (which is+-- different from the chunk length), concatenate the resulting strings, and get+-- the total string length.+--+-- This function should run in constant memory.++longLength ∷ ( Monad m ) ⇒ Int → m (Of Int ())+longLength = SB8.length . SB8.concat . SBS.splitsByteStringAt 10 . genLong++otherLength ∷ ( Monad m ) ⇒ Int → m (Of Int ())+otherLength = SB8.length . SB8.concat . SBS.separatesByteString (SB8.splitAt 10) . genLong++benchmark ∷ (Int → IO (Of Int ())) → Int → Int → IO ()+benchmark !f !k !l = do+ (!seconds, !n :> ()) ← timeItT $ f l+ printf "53 * 10^%2d = %10d characters in %9.6f seconds\n" k n seconds++main = do+ putStrLn "longLength"+ mapM_ (uncurry (benchmark longLength)) [(k ∷ Int, 10^k) | k ← [0..7]]+ putStrLn "otherLength"+ mapM_ (uncurry (benchmark otherLength)) [(k ∷ Int, 10^k) | k ← [0..7]]+ return ()+