T10414.hs

{-# LANGUAGE MagicHash, UnboxedTuples #-}
import GHC.Exts
newtype Eval a = Eval {runEval :: State# RealWorld -> (# State# RealWorld, a #)}

-- inline sequence ::  [Eval a] -> Eval [a]
well_sequenced ::  [Eval a] -> Eval [a]
well_sequenced = foldr cons nil where
  cons e es = Eval $ \s -> case runEval e s of
                       (# s', a #) -> case runEval es s' of
                         (# s'', as #) -> (# s'', a : as #)
  nil = Eval $ \s -> (# s, [] #)

-- seemingly demonic use of spark#
ill_sequenced ::  [Eval a] -> Eval [a]
ill_sequenced  as = Eval $ spark# (case well_sequenced as of
             Eval f -> case f realWorld# of  (# _, a' #) -> a')

-- 'parallelized' version of (show >=> show >=> show >=> show >=> show)
main :: IO ()
main = putStrLn ((layer . layer . layer . layer . layer) (:[]) 'y')
  where
  layer :: (Char -> String) -> (Char -> String)
  layer f = (\(Eval x) -> case x realWorld# of (# _, as #) -> concat as)
        . well_sequenced    -- [Eval String] -> Eval [String]
        . map ill_sequenced -- [[Eval Char]] -> [Eval String];
                            -- 'map well_sequenced' is fine
        . map (map (\x -> Eval $ \s -> (# s, x #))) -- wrap each Char in Eval
        . chunk'            -- String -> [String]
        . concatMap f
        . show              -- add single quotes

  chunk' ::  String -> [String]
  chunk' [] = []
  chunk' xs =  as : chunk' bs where (as,bs) = splitAt 3 xs

  -- this doesn't work:
  -- chunk (a:b:c:xs) = [a,b,c]:chunk xs
  -- chunk xs = [xs]