Skip to content

Instantly share code, notes, and snippets.

@coot

coot/Main.hs Secret

Last active July 10, 2021 06:50
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save coot/4bda8ec91fbf5c22b3d521170d3b98dc to your computer and use it in GitHub Desktop.
`Data.Map.Strict.foldr'` strictness
-- To build:
-- ghc -package ghc-heap-view -package containers Main.hs
--
{-# LANGUAGE BangPatterns #-}
import Control.Exception (evaluate)
import Data.Map (Map)
import Data.Map.Internal (Map (..))
import qualified Data.Map.Strict as Map
import qualified Debug.Trace as Debug
import qualified GHC.HeapView as HeapView
import qualified GHC.HeapView.Debug as HeapView
-- | Like the original 'Map.foldr'', but even more strict!
--
foldr' :: (a -> b -> b) -> b -> Map k a -> b
foldr' f = go
where
go !z Tip = z
go z (Bin _ _ x l r) = go (f x $! go z r) l
main :: IO ()
main = do
putStrLn "\n*** Map.foldr' ***\n"
evaluate y0
HeapView.buildHeapTree 100 (HeapView.asBox y0)
>>= print .HeapView.ppHeapTree
putStrLn "\n*** Map.foldr' & seq ***\n"
evaluate y1
HeapView.buildHeapTree 100 (HeapView.asBox y1)
>>= print . HeapView.ppHeapTree
putStrLn "\n*** foldr' ***"
evaluate y2
HeapView.buildHeapTree 100 (HeapView.asBox y2)
>>= print . HeapView.ppHeapTree
putStrLn "\n*** Map.foldl ***"
evaluate y3
HeapView.buildHeapTree 100 (HeapView.asBox y3)
>>= print . HeapView.ppHeapTree
putStrLn "\n*** Map.foldl' ***"
evaluate y4
HeapView.buildHeapTree 100 (HeapView.asBox y4)
>>= print . HeapView.ppHeapTree
where
x0, x1, x2, x3, x4 :: Map Int Int
y0, y1, y2, y3, y4 :: [Int]
x0 = Map.fromList ((\x -> (x, x)) `map` [1..10])
x1 = Map.fromList ((\x -> (x, x)) `map` [1..10])
x2 = Map.fromList ((\x -> (x, x)) `map` [1..10])
x3 = Map.fromList ((\x -> (x, x)) `map` [1..10])
x4 = Map.fromList ((\x -> (x, x)) `map` [1..10])
y0 = Map.foldr' (:) [] x0
y1 = let r = Map.foldr' (:) [] x1
in length r `seq` r
y2 = foldr' (:) [] x2
y3 = Map.foldl (flip (:)) [] x3
y4 = Map.foldl' (flip (:)) [] x4
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment