1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
4 -- | Converts C-- with full proceedures and parameters
5 -- to a CPS transformed C-- with the stack made manifest.
21 import ZipCfg hiding (zip, unzip)
25 -----------------------------------------------------------------------------
26 -- |Top level driver for the CPS pass
27 -----------------------------------------------------------------------------
28 protoCmmCPSZ :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
29 -> CmmZ -- ^ Input C-- with Proceedures
30 -> IO CmmZ -- ^ Output CPS transformed C--
31 protoCmmCPSZ dflags (Cmm tops)
32 = do { showPass dflags "CPSZ"
33 ; u <- mkSplitUniqSupply 'p'
34 ; let txtops = initUs_ u $ mapM cpsTop tops
35 ; let pgm = Cmm $ runDFTx maxBound $ sequence txtops
36 --- XXX calling runDFTx is totally bogus
37 ; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (ppr pgm)
41 cpsTop :: CmmTopZ -> UniqSM (DFTx CmmTopZ)
42 cpsTop p@(CmmData {}) = return $ return p
43 cpsTop (CmmProc h l args g) =
44 let procPoints = minimalProcPointSet (runTx cmmCfgOptsZ g)
45 g' = addProcPointProtocols procPoints args g
46 g'' = map_nodes id NotSpillOrReload id g'
48 let g = runDFM us dualLiveLattice $ b_rewrite dualLivenessWithInsertion g''
49 -- let igraph = buildIGraph
50 return $ do g' <- g >>= return . map_nodes id spillAndReloadComments id
51 return $ CmmProc h l args g'