diff options
Diffstat (limited to 'compiler/cmm/CmmInfo.hs')
| -rw-r--r-- | compiler/cmm/CmmInfo.hs | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index fe0c104d1c..a171faa057 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -19,6 +19,8 @@ import CmmUtils import CLabel import SMRep import Bitmap +import Stream (Stream) +import qualified Stream import Maybes import Constants @@ -40,10 +42,16 @@ mkEmptyContInfoTable info_lbl , cit_prof = NoProfilingInfo , cit_srt = NoC_SRT } -cmmToRawCmm :: Platform -> [Old.CmmGroup] -> IO [Old.RawCmmGroup] +cmmToRawCmm :: Platform -> Stream IO Old.CmmGroup () + -> IO (Stream IO Old.RawCmmGroup ()) cmmToRawCmm platform cmms = do { uniqs <- mkSplitUniqSupply 'i' - ; return (initUs_ uniqs (mapM (concatMapM (mkInfoTable platform)) cmms)) } + ; let do_one uniqs cmm = do + case initUs uniqs $ concatMapM (mkInfoTable platform) cmm of + (b,uniqs') -> return (uniqs',b) + -- NB. strictness fixes a space leak. DO NOT REMOVE. + ; return (Stream.mapAccumL do_one uniqs cmms >> return ()) + } -- 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 @@ -82,7 +90,7 @@ mkInfoTable :: Platform -> CmmDecl -> UniqSM [RawCmmDecl] mkInfoTable _ (CmmData sec dat) = return [CmmData sec dat] -mkInfoTable platform (CmmProc (CmmInfo _ _ info) entry_label blocks) +mkInfoTable platform (CmmProc info entry_label blocks) | CmmNonInfoTable <- info -- Code without an info table. Easy. = return [CmmProc Nothing entry_label blocks] @@ -91,7 +99,8 @@ mkInfoTable platform (CmmProc (CmmInfo _ _ info) entry_label blocks) ; return (top_decls ++ mkInfoTableAndCode info_lbl info_cts entry_label blocks) } - | otherwise = panic "mkInfoTable" -- Patern match overlap check not clever enough + | otherwise = panic "mkInfoTable" + -- Patern match overlap check not clever enough ----------------------------------------------------- type InfoTableContents = ( [CmmLit] -- The standard part |