--- /dev/null
+module CmmCPS (cmmCPS) where
+
+#include "HsVersions.h"
+
+import Cmm
+import CmmLint
+import PprCmm
+
+import Dataflow (mapCmmTop, onBasicBlock, cmmLivenessComment, cmmLiveness)
+
+import DynFlags
+import ErrUtils
+import Maybes
+import Outputable
+
+import Monad
+import IO
+
+cmmCPS :: DynFlags
+ -> [Cmm] -- C-- with Proceedures
+ -> IO [Cmm] -- Output: CPS transformed C--
+
+cmmCPS dflags abstractC = do
+ when (dopt Opt_DoCmmLinting dflags) $
+ do showPass dflags "CmmLint"
+ case firstJust $ map cmmLint abstractC of
+ Just err -> do printDump err
+ ghcExit dflags 1
+ Nothing -> return ()
+ showPass dflags "CPS"
+ -- continuationC <- return abstractC
+ continuationC <- return $ map (mapCmmTop (onBasicBlock (\bs -> map (cmmLivenessComment (cmmLiveness bs)) bs))) abstractC
+
+ dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (pprCmms continuationC)
+ -- TODO: add option to dump Cmm to file
+ return continuationC
-- debugging flags
= Opt_D_dump_cmm
+ | Opt_D_dump_cps_cmm
| Opt_D_dump_asm
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
, ( "dstg-stats", NoArg (setDynFlag Opt_StgStats))
, ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm)
+ , ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm)
, ( "ddump-asm", setDumpFlag Opt_D_dump_asm)
, ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal)
, ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv)
import SimplStg ( stg2stg )
import CodeGen ( codeGen )
import CmmParse ( parseCmmFile )
+import CmmCPS
import CodeOutput ( codeOutput )
import NameEnv ( emptyNameEnv )
codeGen dflags this_mod data_tycons
foreign_stubs dir_imps cost_centre_info
stg_binds hpc_info
+ ------------------ Convert to CPS --------------------
+ continuationC <- cmmCPS dflags abstractC
------------------ Code output -----------------------
(stub_h_exists,stub_c_exists)
<- codeOutput dflags this_mod location foreign_stubs
- dependencies abstractC
+ dependencies continuationC
return stub_c_exists
hscConst :: b -> a -> Comp b
case maybe_cmm of
Nothing -> return False
Just cmm -> do
- codeOutput dflags no_mod no_loc NoStubs [] [cmm]
+ continuationC <- cmmCPS dflags [cmm]
+ codeOutput dflags no_mod no_loc NoStubs [] continuationC
return True
where
no_mod = panic "hscCmmFile: no_mod"