{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Redundant lambda" #-}
{-# HLINT ignore "Avoid lambda" #-}
{-# HLINT ignore "Use foldr" #-}
{-# HLINT ignore "Use sum" #-}
module Perf.Algos
(
Example (..),
allExamples,
parseExample,
ExamplePattern (..),
examplePattern,
exampleLabel,
testExample,
statExamples,
SumPattern (..),
allSums,
testSum,
statSums,
sumTail,
sumTailLazy,
sumFlip,
sumFlipLazy,
sumCo,
sumCoGo,
sumCoCase,
sumAux,
sumFoldr,
sumCata,
sumSum,
sumMono,
sumPoly,
sumLambda,
sumF,
sumFuse,
sumFusePoly,
sumFuseFoldl',
sumFuseFoldr,
LengthPattern (..),
allLengths,
testLength,
statLengths,
lengthTail,
lengthTailLazy,
lengthFlip,
lengthFlipLazy,
lengthCo,
lengthCoCase,
lengthAux,
lengthFoldr,
lengthFoldrConst,
lengthF,
lengthFMono,
recurseTail,
recurseTailLazy,
recurseFlip,
recurseFlipLazy,
recurseCo,
recurseCoLazy,
recurseCata,
mapInc,
constFuse,
splitHalf,
)
where
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Bifunctor
import Data.Foldable
import Data.Functor.Foldable
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Options.Applicative
import Perf.Types
data Example = ExampleSumFuse | ExampleSum | ExampleLengthF | ExampleConstFuse | ExampleMapInc | ExampleNoOp deriving (Example -> Example -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Example -> Example -> Bool
$c/= :: Example -> Example -> Bool
== :: Example -> Example -> Bool
$c== :: Example -> Example -> Bool
Eq, Int -> Example -> ShowS
[Example] -> ShowS
Example -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Example] -> ShowS
$cshowList :: [Example] -> ShowS
show :: Example -> String
$cshow :: Example -> String
showsPrec :: Int -> Example -> ShowS
$cshowsPrec :: Int -> Example -> ShowS
Show)
allExamples :: [Example]
allExamples :: [Example]
allExamples =
[ Example
ExampleSumFuse,
Example
ExampleSum,
Example
ExampleLengthF,
Example
ExampleConstFuse,
Example
ExampleMapInc,
Example
ExampleNoOp
]
parseExample :: Parser Example
parseExample :: Parser Example
parseExample =
forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleSumFuse (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sumFuse" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"fused sum pipeline")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleSum (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"sum" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"sum")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleLengthF (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"lengthF" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"foldr id length")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleConstFuse (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"constFuse" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"fused const pipeline")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleMapInc (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"mapInc" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"fmap (+1)")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Example
ExampleNoOp (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"noOp" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"const ()")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Example
ExampleSum
data ExamplePattern a
= PatternSumFuse Text ((Num a) => (a -> a)) a
| PatternSum Text ((Num a) => [a] -> a) [a]
| PatternLengthF Text ([a] -> Int) [a]
| PatternConstFuse Text (Int -> ()) Int
| PatternMapInc Text ([Int] -> [Int]) [Int]
| PatternNoOp Text (() -> ()) ()
exampleLabel :: ExamplePattern a -> Text
exampleLabel :: forall a. ExamplePattern a -> Text
exampleLabel (PatternSumFuse Text
l Num a => a -> a
_ a
_) = Text
l
exampleLabel (PatternSum Text
l Num a => [a] -> a
_ [a]
_) = Text
l
exampleLabel (PatternLengthF Text
l [a] -> Int
_ [a]
_) = Text
l
exampleLabel (PatternConstFuse Text
l Int -> ()
_ Int
_) = Text
l
exampleLabel (PatternMapInc Text
l [Int] -> [Int]
_ [Int]
_) = Text
l
exampleLabel (PatternNoOp Text
l () -> ()
_ ()
_) = Text
l
examplePattern :: Example -> Int -> ExamplePattern Int
examplePattern :: Example -> Int -> ExamplePattern Int
examplePattern Example
ExampleSumFuse Int
l = forall a. Text -> (Num a => a -> a) -> a -> ExamplePattern a
PatternSumFuse Text
"sumFuse" Int -> Int
sumFuse Int
l
examplePattern Example
ExampleSum Int
l = forall a. Text -> (Num a => [a] -> a) -> [a] -> ExamplePattern a
PatternSum Text
"sum" forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
1 .. Int
l]
examplePattern Example
ExampleLengthF Int
l = forall a. Text -> ([a] -> Int) -> [a] -> ExamplePattern a
PatternLengthF Text
"lengthF" forall a. [a] -> Int
lengthF [Int
1 .. Int
l]
examplePattern Example
ExampleConstFuse Int
l = forall a. Text -> (Int -> ()) -> Int -> ExamplePattern a
PatternConstFuse Text
"constFuse" Int -> ()
constFuse Int
l
examplePattern Example
ExampleMapInc Int
l = forall a. Text -> ([Int] -> [Int]) -> [Int] -> ExamplePattern a
PatternMapInc Text
"mapInc" [Int] -> [Int]
mapInc [Int
1 .. Int
l]
examplePattern Example
ExampleNoOp Int
_ = forall a. Text -> (() -> ()) -> () -> ExamplePattern a
PatternNoOp Text
"noop" (forall a b. a -> b -> a
const ()) ()
testExample :: (Semigroup a, MonadIO m) => ExamplePattern Int -> PerfT m a ()
testExample :: forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
ExamplePattern Int -> PerfT m a ()
testExample (PatternSumFuse Text
label Num Int => Int -> Int
f Int
a) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Num Int => Int -> Int
f Int
a
testExample (PatternSum Text
label Num Int => [Int] -> Int
f [Int]
a) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Num Int => [Int] -> Int
f [Int]
a
testExample (PatternLengthF Text
label [Int] -> Int
f [Int]
a) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
testExample (PatternConstFuse Text
label Int -> ()
f Int
a) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Int -> ()
f Int
a
testExample (PatternMapInc Text
label [Int] -> [Int]
f [Int]
a) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> [Int]
f [Int]
a
testExample (PatternNoOp Text
label () -> ()
f ()
a) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label () -> ()
f ()
a
statExamples :: (Semigroup a, MonadIO m) => Int -> PerfT m a ()
statExamples :: forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
Int -> PerfT m a ()
statExamples Int
l = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
ExamplePattern Int -> PerfT m a ()
testExample ((Example -> Int -> ExamplePattern Int
`examplePattern` Int
l) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Example]
allExamples)
data SumPattern a
= SumFuse Text (Int -> Int) Int
| SumFusePoly Text ((Enum a, Num a) => a -> a) a
| SumPoly Text ((Num a) => [a] -> a) [a]
| SumMono Text ([Int] -> Int) [Int]
allSums :: Int -> [SumPattern Int]
allSums :: Int -> [SumPattern Int]
allSums Int
l =
[ forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumTail" forall a. Num a => [a] -> a
sumTail [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumTailLazy" forall a. Num a => [a] -> a
sumTailLazy [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumFlip" forall a. Num a => [a] -> a
sumFlip [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumFlipLazy" forall a. Num a => [a] -> a
sumFlipLazy [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCo" forall a. Num a => [a] -> a
sumCo [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCoGo" forall a. Num a => [a] -> a
sumCoGo [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCoCase" forall a. Num a => [a] -> a
sumCoCase [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumAux" forall a. Num a => [a] -> a
sumAux [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumFoldr" forall a. Num a => [a] -> a
sumFoldr [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumCata" forall a. Num a => [a] -> a
sumCata [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumSum" forall a. Num a => [a] -> a
sumSum [Int
1 .. Int
l],
forall a. Text -> ([Int] -> Int) -> [Int] -> SumPattern a
SumMono Text
"sumMono" [Int] -> Int
sumMono [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumPoly" forall a. Num a => [a] -> a
sumPoly [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumLambda" forall a. Num a => [a] -> a
sumLambda [Int
1 .. Int
l],
forall a. Text -> (Num a => [a] -> a) -> [a] -> SumPattern a
SumPoly Text
"sumF" forall a. Num a => [a] -> a
sumF [Int
1 .. Int
l],
forall a. Text -> (Int -> Int) -> Int -> SumPattern a
SumFuse Text
"sumFuse" Int -> Int
sumFuse Int
l,
forall a. Text -> ((Enum a, Num a) => a -> a) -> a -> SumPattern a
SumFusePoly Text
"sumFusePoly" forall a. (Enum a, Num a) => a -> a
sumFusePoly Int
l,
forall a. Text -> (Int -> Int) -> Int -> SumPattern a
SumFuse Text
"sumFuseFoldl'" Int -> Int
sumFuseFoldl' Int
l,
forall a. Text -> (Int -> Int) -> Int -> SumPattern a
SumFuse Text
"sumFuseFoldr" Int -> Int
sumFuseFoldr Int
l
]
testSum :: (Semigroup a, MonadIO m) => SumPattern Int -> PerfT m a Int
testSum :: forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
SumPattern Int -> PerfT m a Int
testSum (SumFuse Text
label Int -> Int
f Int
a) = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Int -> Int
f Int
a
testSum (SumFusePoly Text
label (Enum Int, Num Int) => Int -> Int
f Int
a) = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label (Enum Int, Num Int) => Int -> Int
f Int
a
testSum (SumMono Text
label [Int] -> Int
f [Int]
a) = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
testSum (SumPoly Text
label Num Int => [Int] -> Int
f [Int]
a) = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label Num Int => [Int] -> Int
f [Int]
a
statSums :: (MonadIO m) => Int -> Int -> (Int -> Measure m [a]) -> m (Map.Map Text [a])
statSums :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Int -> (Int -> Measure m [a]) -> m (Map Text [a])
statSums Int
n Int
l Int -> Measure m [a]
m = forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT (Int -> Measure m [a]
m Int
n) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
SumPattern Int -> PerfT m a Int
testSum (Int -> [SumPattern Int]
allSums Int
l)
sumTail :: (Num a) => [a] -> a
sumTail :: forall a. Num a => [a] -> a
sumTail = forall {t}. Num t => t -> [t] -> t
go a
0
where
go :: t -> [t] -> t
go t
acc [] = t
acc
go t
acc (t
x : [t]
xs) = t -> [t] -> t
go (t
x forall a. Num a => a -> a -> a
+ t
acc) forall a b. (a -> b) -> a -> b
$! [t]
xs
sumTailLazy :: (Num a) => [a] -> a
sumTailLazy :: forall a. Num a => [a] -> a
sumTailLazy = forall {t}. Num t => t -> [t] -> t
go a
0
where
go :: t -> [t] -> t
go t
acc [] = t
acc
go t
acc (t
x : [t]
xs) = t -> [t] -> t
go (t
x forall a. Num a => a -> a -> a
+ t
acc) forall a b. (a -> b) -> a -> b
$! [t]
xs
sumFlip :: (Num a) => [a] -> a
sumFlip :: forall a. Num a => [a] -> a
sumFlip [a]
xs0 = forall {a}. Num a => [a] -> a -> a
go [a]
xs0 a
0
where
go :: [a] -> a -> a
go [] a
s = a
s
go (a
x : [a]
xs) a
s = [a] -> a -> a
go [a]
xs forall a b. (a -> b) -> a -> b
$! a
x forall a. Num a => a -> a -> a
+ a
s
sumFlipLazy :: (Num a) => [a] -> a
sumFlipLazy :: forall a. Num a => [a] -> a
sumFlipLazy [a]
xs0 = forall {a}. Num a => [a] -> a -> a
go [a]
xs0 a
0
where
go :: [a] -> a -> a
go [] a
s = a
s
go (a
x : [a]
xs) a
s = [a] -> a -> a
go [a]
xs forall a b. (a -> b) -> a -> b
$ a
x forall a. Num a => a -> a -> a
+ a
s
sumCo :: (Num a) => [a] -> a
sumCo :: forall a. Num a => [a] -> a
sumCo [] = a
0
sumCo (a
x : [a]
xs) = a
x forall a. Num a => a -> a -> a
+ forall a. Num a => [a] -> a
sumCo [a]
xs
sumCoGo :: (Num a) => [a] -> a
sumCoGo :: forall a. Num a => [a] -> a
sumCoGo = forall a. Num a => [a] -> a
go
where
go :: [a] -> a
go [] = a
0
go (a
x : [a]
xs) = a
x forall a. Num a => a -> a -> a
+ [a] -> a
go [a]
xs
sumCoCase :: (Num a) => [a] -> a
sumCoCase :: forall a. Num a => [a] -> a
sumCoCase = \case
[] -> a
0
(a
x : [a]
xs) -> a
x forall a. Num a => a -> a -> a
+ forall a. Num a => [a] -> a
sumCoCase [a]
xs
sumAux :: (Num a) => [a] -> a
sumAux :: forall a. Num a => [a] -> a
sumAux = \case
[] -> a
b
(a
x : [a]
xs) -> forall a. Num a => a -> a -> a
f a
x (forall a. Num a => [a] -> a
sumAux [a]
xs)
where
b :: a
b = a
0
f :: a -> a -> a
f a
x a
xs = a
x forall a. Num a => a -> a -> a
+ a
xs
sumFoldr :: (Num a) => [a] -> a
sumFoldr :: forall a. Num a => [a] -> a
sumFoldr [a]
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Num a => a -> a -> a
(+) a
0 [a]
xs
sumCata :: (Num a) => [a] -> a
sumCata :: forall a. Num a => [a] -> a
sumCata = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
Base [a] a
ListF a a
Nil -> a
0
Cons a
x a
acc -> a
x forall a. Num a => a -> a -> a
+ a
acc
sumSum :: (Num a) => [a] -> a
sumSum :: forall a. Num a => [a] -> a
sumSum [a]
xs = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
xs
sumMono :: [Int] -> Int
sumMono :: [Int] -> Int
sumMono [Int]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) Int
0 [Int]
xs
sumPoly :: (Num a) => [a] -> a
sumPoly :: forall a. Num a => [a] -> a
sumPoly [a]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0 [a]
xs
sumLambda :: (Num a) => [a] -> a
sumLambda :: forall a. Num a => [a] -> a
sumLambda = \[a]
xs -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0 [a]
xs
sumF' :: (Num a) => a -> (a -> a) -> a -> a
sumF' :: forall a. Num a => a -> (a -> a) -> a -> a
sumF' a
x a -> a
r = \ !a
a -> a -> a
r (a
x forall a. Num a => a -> a -> a
+ a
a)
sumF :: (Num a) => [a] -> a
sumF :: forall a. Num a => [a] -> a
sumF [a]
xs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Num a => a -> (a -> a) -> a -> a
sumF' forall a. a -> a
id [a]
xs a
0
sumFuse :: Int -> Int
sumFuse :: Int -> Int
sumFuse Int
x = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
1 .. Int
x]
sumFusePoly :: (Enum a, Num a) => a -> a
sumFusePoly :: forall a. (Enum a, Num a) => a -> a
sumFusePoly a
x = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a
1 .. a
x]
sumFuseFoldl' :: Int -> Int
sumFuseFoldl' :: Int -> Int
sumFuseFoldl' Int
x = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) Int
0 [Int
1 .. Int
x]
sumFuseFoldr :: Int -> Int
sumFuseFoldr :: Int -> Int
sumFuseFoldr Int
x = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Num a => a -> a -> a
(+) Int
0 [Int
1 .. Int
x]
data LengthPattern a
= LengthPoly Text ([a] -> Int) [a]
| LengthMono Text ([Int] -> Int) [Int]
allLengths :: Int -> [LengthPattern Int]
allLengths :: Int -> [LengthPattern Int]
allLengths Int
l =
[ forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthTail" forall a. [a] -> Int
lengthTail [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthTailLazy" forall a. [a] -> Int
lengthTailLazy [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFlip" forall a. [a] -> Int
lengthFlip [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFlipLazy" forall a. [a] -> Int
lengthFlipLazy [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthCo" forall a. [a] -> Int
lengthCo [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthCoCase" forall a. [a] -> Int
lengthCoCase [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthAux" forall a. [a] -> Int
lengthAux [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFoldr" forall a. [a] -> Int
lengthFoldr [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthFoldrConst" forall a. [a] -> Int
lengthFoldrConst [Int
1 .. Int
l],
forall a. Text -> ([a] -> Int) -> [a] -> LengthPattern a
LengthPoly Text
"lengthF" forall a. [a] -> Int
lengthF [Int
1 .. Int
l],
forall a. Text -> ([Int] -> Int) -> [Int] -> LengthPattern a
LengthMono Text
"lengthFMono" [Int] -> Int
lengthFMono [Int
1 .. Int
l]
]
testLength :: (Semigroup a, MonadIO m) => LengthPattern Int -> PerfT m a Int
testLength :: forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
LengthPattern Int -> PerfT m a Int
testLength (LengthMono Text
label [Int] -> Int
f [Int]
a) = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
testLength (LengthPoly Text
label [Int] -> Int
f [Int]
a) = forall (m :: * -> *) t a b.
(MonadIO m, Semigroup t) =>
Text -> (a -> b) -> a -> PerfT m t b
fap Text
label [Int] -> Int
f [Int]
a
statLengths :: (MonadIO m) => Int -> Int -> (Int -> Measure m [a]) -> m (Map.Map Text [a])
statLengths :: forall (m :: * -> *) a.
MonadIO m =>
Int -> Int -> (Int -> Measure m [a]) -> m (Map Text [a])
statLengths Int
n Int
l Int -> Measure m [a]
m = forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT (Int -> Measure m [a]
m Int
n) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a (m :: * -> *).
(Semigroup a, MonadIO m) =>
LengthPattern Int -> PerfT m a Int
testLength (Int -> [LengthPattern Int]
allLengths Int
l)
lengthTail :: [a] -> Int
lengthTail :: forall a. [a] -> Int
lengthTail [a]
xs0 = forall {t} {a}. Num t => t -> [a] -> t
go Int
0 [a]
xs0
where
go :: t -> [a] -> t
go t
s [] = t
s
go t
s (a
_ : [a]
xs) = t -> [a] -> t
go (t
s forall a. Num a => a -> a -> a
+ t
1) forall a b. (a -> b) -> a -> b
$! [a]
xs
lengthTailLazy :: [a] -> Int
lengthTailLazy :: forall a. [a] -> Int
lengthTailLazy [a]
xs0 = forall {t} {a}. Num t => t -> [a] -> t
go Int
0 [a]
xs0
where
go :: t -> [a] -> t
go t
s [] = t
s
go t
s (a
_ : [a]
xs) = t -> [a] -> t
go (t
s forall a. Num a => a -> a -> a
+ t
1) [a]
xs
lengthFlip :: [a] -> Int
lengthFlip :: forall a. [a] -> Int
lengthFlip [a]
xs0 = forall {a} {a}. Num a => [a] -> a -> a
go [a]
xs0 Int
0
where
go :: [a] -> a -> a
go [] a
s = a
s
go (a
_ : [a]
xs) a
s = [a] -> a -> a
go [a]
xs forall a b. (a -> b) -> a -> b
$! a
s forall a. Num a => a -> a -> a
+ a
1
lengthFlipLazy :: [a] -> Int
lengthFlipLazy :: forall a. [a] -> Int
lengthFlipLazy [a]
xs0 = forall {a} {a}. Num a => [a] -> a -> a
go [a]
xs0 Int
0
where
go :: [a] -> a -> a
go [] a
s = a
s
go (a
_ : [a]
xs) a
s = [a] -> a -> a
go [a]
xs forall a b. (a -> b) -> a -> b
$ a
s forall a. Num a => a -> a -> a
+ a
1
lengthCo :: [a] -> Int
lengthCo :: forall a. [a] -> Int
lengthCo [] = Int
0
lengthCo (a
_ : [a]
xs) = Int
1 forall a. Num a => a -> a -> a
+ forall a. [a] -> Int
lengthCo [a]
xs
lengthCoCase :: [a] -> Int
lengthCoCase :: forall a. [a] -> Int
lengthCoCase = \case
[] -> Int
0
(a
_ : [a]
xs) -> Int
1 forall a. Num a => a -> a -> a
+ forall a. [a] -> Int
lengthCoCase [a]
xs
lengthAux :: [a] -> Int
lengthAux :: forall a. [a] -> Int
lengthAux = \case
[] -> Int
b
(a
x : [a]
xs) -> forall {a} {p}. Num a => p -> a -> a
f a
x (forall a. [a] -> Int
lengthAux [a]
xs)
where
b :: Int
b = Int
0
f :: p -> a -> a
f p
_ a
xs = a
1 forall a. Num a => a -> a -> a
+ a
xs
lengthFoldr :: [a] -> Int
lengthFoldr :: forall a. [a] -> Int
lengthFoldr = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {p}. Num a => p -> a -> a
f Int
b
where
b :: Int
b = Int
0
f :: p -> a -> a
f p
_ a
xs = a
1 forall a. Num a => a -> a -> a
+ a
xs
lengthFoldrConst :: [a] -> Int
lengthFoldrConst :: forall a. [a] -> Int
lengthFoldrConst = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b. a -> b -> a
const (Int
1 +)) Int
0
lengthF' :: (Num a) => x -> (a -> a) -> a -> a
lengthF' :: forall a x. Num a => x -> (a -> a) -> a -> a
lengthF' x
_ a -> a
r = \ !a
a -> a -> a
r (a
a forall a. Num a => a -> a -> a
+ a
1)
lengthF :: [a] -> Int
lengthF :: forall a. [a] -> Int
lengthF [a]
xs0 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a x. Num a => x -> (a -> a) -> a -> a
lengthF' forall a. a -> a
id [a]
xs0 Int
0
lengthFMono :: [Int] -> Int
lengthFMono :: [Int] -> Int
lengthFMono [Int]
xs0 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a x. Num a => x -> (a -> a) -> a -> a
lengthF' forall a. a -> a
id [Int]
xs0 Int
0
recurseTail :: (a -> b -> b) -> b -> [a] -> b
recurseTail :: forall a b. (a -> b -> b) -> b -> [a] -> b
recurseTail a -> b -> b
f = b -> [a] -> b
go
where
go :: b -> [a] -> b
go b
s [] = b
s
go b
s (a
x : [a]
xs) = b -> [a] -> b
go (a -> b -> b
f a
x b
s) forall a b. (a -> b) -> a -> b
$! [a]
xs
recurseTailLazy :: (a -> b -> b) -> b -> [a] -> b
recurseTailLazy :: forall a b. (a -> b -> b) -> b -> [a] -> b
recurseTailLazy a -> b -> b
f = b -> [a] -> b
go
where
go :: b -> [a] -> b
go b
s [] = b
s
go b
s (a
x : [a]
xs) = b -> [a] -> b
go (a -> b -> b
f a
x b
s) [a]
xs
recurseFlip :: (a -> b -> b) -> b -> [a] -> b
recurseFlip :: forall a b. (a -> b -> b) -> b -> [a] -> b
recurseFlip a -> b -> b
f b
s0 [a]
xs0 = [a] -> b -> b
go [a]
xs0 b
s0
where
go :: [a] -> b -> b
go [] b
s = b
s
go (a
x : [a]
xs) b
s = [a] -> b -> b
go [a]
xs forall a b. (a -> b) -> a -> b
$! a -> b -> b
f a
x b
s
recurseFlipLazy :: (a -> b -> b) -> b -> [a] -> b
recurseFlipLazy :: forall a b. (a -> b -> b) -> b -> [a] -> b
recurseFlipLazy a -> b -> b
f b
s0 [a]
xs0 = [a] -> b -> b
go [a]
xs0 b
s0
where
go :: [a] -> b -> b
go [] b
s = b
s
go (a
x : [a]
xs) b
s = [a] -> b -> b
go [a]
xs forall a b. (a -> b) -> a -> b
$ a -> b -> b
f a
x b
s
recurseCo :: (a -> b -> b) -> b -> [a] -> b
recurseCo :: forall a b. (a -> b -> b) -> b -> [a] -> b
recurseCo a -> b -> b
f b
s0 = [a] -> b
go
where
go :: [a] -> b
go [] = b
s0
go (a
x : [a]
xs) = a -> b -> b
f a
x forall a b. (a -> b) -> a -> b
$! [a] -> b
go [a]
xs
recurseCoLazy :: (a -> b -> b) -> b -> [a] -> b
recurseCoLazy :: forall a b. (a -> b -> b) -> b -> [a] -> b
recurseCoLazy a -> b -> b
f b
s0 = [a] -> b
go
where
go :: [a] -> b
go [] = b
s0
go (a
x : [a]
xs) = a -> b -> b
f a
x forall a b. (a -> b) -> a -> b
$ [a] -> b
go [a]
xs
recurseCata :: (a -> b -> b) -> b -> [a] -> b
recurseCata :: forall a b. (a -> b -> b) -> b -> [a] -> b
recurseCata a -> b -> b
f b
s0 = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
Base [a] b
ListF a b
Nil -> b
s0
Cons a
x b
acc -> a -> b -> b
f a
x b
acc
constFuse :: Int -> ()
constFuse :: Int -> ()
constFuse Int
x = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a b. a -> b -> a
const () [Int
1 .. Int
x]
mapInc :: [Int] -> [Int]
mapInc :: [Int] -> [Int]
mapInc [Int]
xs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Int
1) [Int]
xs
splitHalf :: [a] -> ([a], [a])
splitHalf :: forall a. [a] -> ([a], [a])
splitHalf [a]
xs = forall {a} {a}. [a] -> [a] -> ([a], [a])
go [a]
xs [a]
xs
where
go :: [a] -> [a] -> ([a], [a])
go (a
y : [a]
ys) (a
_ : a
_ : [a]
zs) = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
y :) ([a] -> [a] -> ([a], [a])
go [a]
ys [a]
zs)
go [a]
ys [a]
_ = ([], [a]
ys)