Reimplement Stream in "yoneda" style for efficiency

'Stream' is implemented in the "yoneda" style for efficiency. By
representing a stream in this manner 'fmap' and '>>=' operations are
accumulated in the function parameters before being applied once when
the stream is destroyed. In the old implementation each usage of 'mapM'
and '>>=' would traverse the entire stream in order to apply the
substitution at the leaves. It is well-known for free monads that this
representation can improve performance, and the test results
demonstrate this for GHC as well.

The operation mapAccumL is not used in the compiler and can't be
implemented efficiently because it requires destroying and rebuilding
the stream.

I removed one use of mapAccumL_ which has similar problems but the other
use was difficult to remove. In the future it may be worth exploring
whether the 'Stream' encoding could be modified further to capture the
mapAccumL pattern, and likewise defer the passing of accumulation
parameter until the stream is finally consumed.

The >>= operation for 'Stream' was a hot-spot in the ticky profile for
the "ManyConstructors" test which called the 'cg' function many times in
"StgToCmm.hs"

Metric Decrease:
    ManyConstructors

1 files changed, 10 insertions, 9 deletions

diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 9298df2544..eaa3c2a923 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -72,19 +72,20 @@ mkEmptyContInfoTable info_lbl
 cmmToRawCmm :: Logger -> DynFlags -> Stream IO CmmGroupSRTs a
             -> IO (Stream IO RawCmmGroup a)
 cmmToRawCmm logger dflags cmms
-  = do { uniqs <- mkSplitUniqSupply 'i'
-       ; let do_one :: UniqSupply -> [CmmDeclSRTs] -> IO (UniqSupply, [RawCmmDecl])
-             do_one uniqs cmm =
+  = do {
+       ; let do_one :: [CmmDeclSRTs] -> IO [RawCmmDecl]
+             do_one cmm = do
+               uniqs <- mkSplitUniqSupply 'i'
                -- NB. strictness fixes a space leak.  DO NOT REMOVE.
                withTimingSilent logger dflags (text "Cmm -> Raw Cmm")
-                                forceRes $
-                 case initUs uniqs $ concatMapM (mkInfoTable dflags) cmm of
-                   (b,uniqs') -> return (uniqs',b)
-       ; return (snd <$> Stream.mapAccumL_ do_one uniqs cmms)
+                          (\x -> seqList x ())
+                  -- TODO: It might be better to make `mkInfoTable` run in
+                  -- IO as well so we don't have to pass around
+                  -- a UniqSupply (see #16843)
+                 (return $ initUs_ uniqs $ concatMapM (mkInfoTable dflags) cmm)
+       ; return (Stream.mapM do_one cmms)
        }
 
-    where forceRes (uniqs, rawcmms) =
-            uniqs `seq` foldr (\decl r -> decl `seq` r) () rawcmms
 
 -- Make a concrete info table, represented as a list of CmmStatic
 -- (it can't be simply a list of Word, because the SRT field is