massive convulsion in ZipDataflow

After my talk, I got the idea of 'shallow rewriting' for the
dataflow framework.  Here it is implemented, along with
some related ideas late making Graph and not LGraph primary.

The only bad thing is that the whole bit is stitched together
out of ill-fitting pieces, kind of like Frankenstein's monster.
A new ZipDataflow will rise out of the ashes.

1 files changed, 39 insertions, 19 deletions

diff --git a/compiler/cmm/CmmCPSZ.hs b/compiler/cmm/CmmCPSZ.hs
index 4dff9bc1d4..35c20c048e 100644
--- a/compiler/cmm/CmmCPSZ.hs
+++ b/compiler/cmm/CmmCPSZ.hs
@@ -12,14 +12,17 @@ import CmmProcPointZ
 import CmmSpillReload
 import CmmTx
 import DFMonad
+import PprCmmZ()
+import ZipCfg hiding (zip, unzip)
+import ZipCfgCmmRep
+import ZipDataflow0
+
 import DynFlags
 import ErrUtils
 import Outputable
-import PprCmmZ()
 import UniqSupply
-import ZipCfg hiding (zip, unzip)
-import ZipCfgCmmRep
-import ZipDataflow
+
+import Data.IORef
 
 -----------------------------------------------------------------------------
 -- |Top level driver for the CPS pass
@@ -30,25 +33,42 @@ protoCmmCPSZ :: DynFlags -- ^ Dynamic flags: -dcmm-lint -ddump-cps-cmm
 protoCmmCPSZ dflags (Cmm tops)
   = do	{ showPass dflags "CPSZ"
         ; u <- mkSplitUniqSupply 'p'
+        ; pass_ref <- newIORef "unoptimized program" -- XXX see [Note global fuel]
+        ; fuel_ref <- newIORef (tankFilledTo maxBound) -- XXX see [Note global fuel]
         ; let txtops = initUs_ u $ mapM cpsTop tops
-        ; let pgm = Cmm $ runDFTx maxBound $ sequence txtops
-           --- XXX calling runDFTx is totally bogus
-	; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (ppr pgm)
-        ; return pgm
+        ; tops <- runFuelIO pass_ref fuel_ref (sequence txtops)
+	; dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "CPS Cmm" (ppr (Cmm tops))
+        ; return $ Cmm tops
         }
 
-cpsTop :: CmmTopZ -> UniqSM (DFTx CmmTopZ)
-cpsTop p@(CmmData {}) = return $ return p
+{- [Note global fuel]
+~~~~~~~~~~~~~~~~~~~~~
+In a correct world, the identity and the last pass would be stored in
+mutable reference cells associated with an 'HscEnv' and would be
+global to one compiler session.  Unfortunately the 'HscEnv' is not
+plumbed sufficiently close to this function; only the DynFlags are
+plumbed here.  One day the plumbing will be extended, in which case
+this pass will use the global 'pass_ref' and 'fuel_ref' instead of the
+bogus facsimiles in place here.
+-}
+
+cpsTop :: CmmTopZ -> UniqSM (FuelMonad CmmTopZ)
+cpsTop p@(CmmData {}) = return (return p)
 cpsTop (CmmProc h l args g) =
     let procPoints = minimalProcPointSet (runTx cmmCfgOptsZ g)
         g' = addProcPointProtocols procPoints args g
         g'' = map_nodes id NotSpillOrReload id g'
-    in do g <- dual_rewrite dualLivenessWithInsertion g''
-          g <- return (g >>= insertLateReloads)
-          u <- getUs
-          let g' = g >>= (initUs_ u . dual_rewrite removeDeadAssignmentsAndReloads)
-          return $ do g <- g' >>= return . map_nodes id spillAndReloadComments id
-                      return $ CmmProc h l args g
-  where dual_rewrite pass g =
-            do us <- getUs
-               return $ runDFM us dualLiveLattice $ b_rewrite pass g
+    in do { u1 <- getUs; u2 <- getUs; u3 <- getUs
+          ; entry <- getUniqueUs >>= return . BlockId
+          ; return $ 
+              do { g <- return g''
+                 ; g <- dual_rewrite u1 dualLivenessWithInsertion g
+                 ; g <- insertLateReloads' u2 (extend g)
+                 ; g <- dual_rewrite u3 removeDeadAssignmentsAndReloads (trim entry g)
+                 ; return $ CmmProc h l args $ map_nodes id spillAndReloadComments id g
+                 }
+          }
+  where dual_rewrite u pass g = runDFM u dualLiveLattice $ b_rewrite pass g
+        extend (LGraph eid blocks) = Graph (ZLast $ mkBranchNode eid) blocks
+        trim _ (Graph (ZLast (LastOther (LastBranch id))) blocks) = LGraph id blocks
+        trim e (Graph tail blocks) = LGraph e (insertBlock (Block e tail) blocks)