Make non-streaming LLVM and C backends streaming

This adds a Stream.consume function, uses it in LLVM and C code
generators, and removes the use of Stream.collect function which was
used to collect streaming Cmm generation results into a list.

LLVM and C backends now properly use streamed Cmm generation, instead of
collecting Cmm groups into a list before generating LLVM/C code.

4 files changed, 19 insertions, 20 deletions

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index d412969ca7..506116c584 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -19,8 +19,7 @@
 -----------------------------------------------------------------------------
 
 module PprC (
-        writeCs,
-        pprStringInCStyle
+        writeC
   ) where
 
 #include "HsVersions.h"
@@ -68,13 +67,8 @@ import Data.Array.ST
 -- --------------------------------------------------------------------------
 -- Top level
 
-pprCs :: [RawCmmGroup] -> SDoc
-pprCs cmms
- = pprCode CStyle (vcat $ map pprC cmms)
-
-writeCs :: DynFlags -> Handle -> [RawCmmGroup] -> IO ()
-writeCs dflags handle cmms
-  = printForC dflags handle (pprCs cmms)
+writeC :: DynFlags -> Handle -> RawCmmGroup -> IO ()
+writeC dflags handle cmm = printForC dflags handle (pprC cmm $$ blankLine)
 
 -- --------------------------------------------------------------------------
 -- Now do some real work
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index da733f4bb4..2a568f820f 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -79,8 +79,7 @@ llvmCodeGen' cmm_stream
         cmmMetaLlvmPrelude
 
         -- Procedures
-        let llvmStream = Stream.mapM llvmGroupLlvmGens cmm_stream
-        _ <- Stream.collect llvmStream
+        () <- Stream.consume cmm_stream llvmGroupLlvmGens
 
         -- Declare aliases for forward references
         renderLlvm . pprLlvmData =<< generateExternDecls
diff --git a/compiler/main/CodeOutput.hs b/compiler/main/CodeOutput.hs
index 4133526532..66c11f08a4 100644
--- a/compiler/main/CodeOutput.hs
+++ b/compiler/main/CodeOutput.hs
@@ -12,19 +12,19 @@ module CodeOutput( codeOutput, outputForeignStubs ) where
 
 import GhcPrelude
 
-import AsmCodeGen ( nativeCodeGen )
-import LlvmCodeGen ( llvmCodeGen )
+import AsmCodeGen       ( nativeCodeGen )
+import LlvmCodeGen      ( llvmCodeGen )
 
 import UniqSupply       ( mkSplitUniqSupply )
 
 import Finder           ( mkStubPaths )
-import PprC             ( writeCs )
+import PprC             ( writeC )
 import CmmLint          ( cmmLint )
 import Packages
 import Cmm              ( RawCmmGroup )
 import HscTypes
 import DynFlags
-import Stream           (Stream)
+import Stream           ( Stream )
 import qualified Stream
 import FileCleanup
 
@@ -117,9 +117,6 @@ outputC :: DynFlags
 
 outputC dflags filenm cmm_stream packages
   = do
-       -- ToDo: make the C backend consume the C-- incrementally, by
-       -- pushing the cmm_stream inside (c.f. nativeCodeGen)
-       rawcmms <- Stream.collect cmm_stream
        withTiming (return dflags) (text "C codegen") id $ do
 
          -- figure out which header files to #include in the generated .hc file:
@@ -142,7 +139,7 @@ outputC dflags filenm cmm_stream packages
          doOutput filenm $ \ h -> do
             hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
             hPutStr h cc_injects
-            writeCs dflags h rawcmms
+            Stream.consume cmm_stream (writeC dflags h)
 
 {-
 ************************************************************************
diff --git a/compiler/utils/Stream.hs b/compiler/utils/Stream.hs
index ad01fad40c..2ad2b8cc7a 100644
--- a/compiler/utils/Stream.hs
+++ b/compiler/utils/Stream.hs
@@ -7,7 +7,7 @@
 -- -----------------------------------------------------------------------------
 module Stream (
     Stream(..), yield, liftIO,
-    collect, fromList,
+    collect, consume, fromList,
     Stream.map, Stream.mapM, Stream.mapAccumL
   ) where
 
@@ -71,6 +71,15 @@ collect str = go str []
       Left () -> return (reverse acc)
       Right (a, str') -> go str' (a:acc)
 
+consume :: Monad m => Stream m a b -> (a -> m ()) -> m b
+consume str f = do
+    r <- runStream str
+    case r of
+      Left ret -> return ret
+      Right (a, str') -> do
+        f a
+        consume str' f
+
 -- | Turn a list into a 'Stream', by yielding each element in turn.
 fromList :: Monad m => [a] -> Stream m a ()
 fromList = mapM_ yield