Skip to content

Instantly share code, notes, and snippets.

@michaelt
Created May 6, 2016 14:32
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save michaelt/a25e8e11735b6953d03ce0974147b447 to your computer and use it in GitHub Desktop.
Save michaelt/a25e8e11735b6953d03ce0974147b447 to your computer and use it in GitHub Desktop.
test inline/inlinable with a simple index fold
{-#LANGUAGE BangPatterns #-}
import Control.Foldl (Fold(..))
import qualified Control.Foldl as L
import qualified Data.Vector.Unboxed as V
import qualified Data.Sequence as Seq
import Control.Applicative
import Criterion.Main
import System.Environment
a >< b = fmap (,) a <*> b
main = do
f:n:_ <- getArgs
case f of
"v" -> do
let folder = L.purely_ (\a b -> V.foldl a b (V.enumFromTo 1 (10^6::Int)))
case n of
"1" -> print $ folder $ index (10^4+1)
"2" -> print $ folder $ index (10^4) >< index (10^4+1)
"3" -> print $ folder $ index (10^4-1) >< index (10^4) >< index (10^4+1)
"s" -> do
let folder = flip L.fold (Seq.replicate (10^6) (1::Int))
case n of
"1" -> print $ folder $ index (10^4+1)
"2" -> print $ folder $ index (10^4) >< index (10^4+1)
"3" -> print $ folder $ index (10^4-1) >< index (10^4) >< index (10^4+1)
"l" -> do
let folder = flip L.fold (enumFromTo 1 (10^6::Int))
case n of
"1" -> print $ folder $ index (10^4+1)
"2" -> print $ folder $ index (10^4) >< index (10^4+1)
"3" -> print $ folder $ index (10^4-1) >< index (10^4) >< index (10^4+1)
-- L.fold folds $ Seq.replicate (10^4) (1::Int) where
-- -- folds = (index (10^6+1))
-- folds = liftA2 (,) (index (10^2-1)) $ liftA2 (,) (index (10^2)) (index (10^2+1))
data IndexSt a = NotYet !Int | Yet !a
index :: Int -> Fold a (Maybe a)
index n = Fold step (NotYet n) done where
step (Yet a) _ = Yet a
step (NotYet 0) a = Yet a
step (NotYet n) a = NotYet (n-1)
done (NotYet _) = Nothing
done (Yet a) = Just a
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment