diff options
| -rw-r--r-- | compiler/cmm/PprC.hs | 12 | ||||
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen.hs | 3 | ||||
| -rw-r--r-- | compiler/main/CodeOutput.hs | 13 | ||||
| -rw-r--r-- | compiler/utils/Stream.hs | 11 |
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 |