forM_ memory test

run.sh

#!/usr/bin/env bash

set -eu

stack ghc -- -O2 test4.hs -rtsopts

for n in 5000 50000 500000 5000000; do
for impl in roman michael base; do
  printf "%7d %10s" $n $impl
  ./test4 $impl $n +RTS -s 2>&1|perl -lne '/(^.*bytes).*residency/&&print $1'
done
done

test4.hs

import Control.Monad
import Data.Foldable
import System.Environment

forM_1 :: (Monad m, Traversable t) => t a -> (a -> m ()) -> m ()
forM_1 a f =
  let l = toList a
      b = (False <$ tail l) ++ [True]
  in
  foldr (\(x,b) r -> if b then f x else f x >> r)
        (return ()) (zip l b)
forM_2 :: (Applicative m, Foldable f) => f a -> (a -> m ()) -> m ()
forM_2 a f =
    go (toList a)
  where
    go [] = pure ()
    go [x] = f x -- here's the magic
    go (x:xs) = f x *> go xs

uncons :: [a] -> Maybe (a, [a])
uncons [] = Nothing
uncons (x:xs) = Just (x, xs)

printChars idx str impl = impl (uncons str) $ \(c, str') -> do
    when (idx `mod` 100000 == 0)
        $ putStrLn $ "Character #" ++ show idx ++ ": " ++ show c
    printChars (idx + 1) str' impl

main :: IO ()
main = do
  args <- getArgs
  let
    impl :: Maybe a -> (a -> IO ()) -> IO ()
    impl =
      case args !! 0 of
        "base" -> forM_
        "roman" -> forM_1
        "michael" -> forM_2
    n = read $ args !! 1
  printChars 1 (replicate n 'x') impl