compiler/cmm/CmmCPS.hs

   1 module CmmCPS (cmmCPS) where
   2
   3 #include "HsVersions.h"
   4
   5 import Cmm
   6 import CmmLint
   7 import PprCmm
   8
   9 import Dataflow (mapCmmTop, onBasicBlock, cmmLivenessComment, cmmLiveness)
  10
  11 import DynFlags
  12 import ErrUtils
  13 import Maybes
  14 import Outputable
  15
  16 import Monad
  17 import IO
  18
  19 cmmCPS :: DynFlags
  20        -> [Cmm]                 -- C-- with Proceedures
  21        -> IO [Cmm]              -- Output: CPS transformed C--
  22
  23 cmmCPS dflags abstractC = do
  24   when (dopt Opt_DoCmmLinting dflags) $
  25        do showPass dflags "CmmLint"
  26           case firstJust $ map cmmLint abstractC of
  27             Just err -> do printDump err
  28                            ghcExit dflags 1
  29             Nothing  -> return ()
  30   showPass dflags "CPS"
  31   -- continuationC <- return abstractC
  32   continuationC <- return $ map (mapCmmTop (onBasicBlock (\bs -> map (cmmLivenessComment (cmmLiveness bs)) bs))) abstractC
  33
  34   dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
  35   -- TODO: add option to dump Cmm to file
  36   return continuationC