Remove (most of) the FiniteMap wrapper

[ghc-hetmet.git] / compiler / cmm / CmmProcPointZ.hs

diff --git a/compiler/cmm/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs
index c34f041..c972ad5 100644 (file)
--- a/compiler/cmm/CmmProcPointZ.hs
+++ b/compiler/cmm/CmmProcPointZ.hs
@@ -15,7 +15,6 @@ import CmmInfo
 import CmmLiveZ
 import CmmTx
 import DFMonad
-import FiniteMap
 import Data.List (sortBy)
 import Maybes
 import MkZipCfg
@@ -28,6 +27,8 @@ import ZipCfg
 import ZipCfgCmmRep
 import ZipDataflow
 
+import qualified Data.Map as Map
+
 -- Compute a minimal set of proc points for a control-flow graph.
 
 -- Determine a protocol for each proc point (which live variables will
@@ -127,18 +128,21 @@ forward = ForwardTransfers first middle last exit
 -- those that are induced by calls in the original graph
 -- and those that are introduced because they're reachable from multiple proc points.
 callProcPoints      :: CmmGraph -> ProcPointSet
-minimalProcPointSet :: ProcPointSet -> CmmGraph -> FuelMonad ProcPointSet
-
 callProcPoints g = fold_blocks add (unitBlockSet (lg_entry g)) g
   where add b set = case last $ unzip b of
                       LastOther (LastCall _ (Just k) _ _ _) -> extendBlockSet set k
                       _ -> set
 
+minimalProcPointSet :: ProcPointSet -> CmmGraph -> FuelMonad ProcPointSet
+-- Given the set of successors of calls (which must be proc-points)
+-- figure ou the minimal set of necessary proc-points
 minimalProcPointSet callProcPoints g = extendPPSet g (postorder_dfs g) callProcPoints
 
 type PPFix = FuelMonad (ForwardFixedPoint Middle Last Status ())
 
 procPointAnalysis :: ProcPointSet -> CmmGraph -> FuelMonad (BlockEnv Status)
+-- Once you know what the proc-points are, figure out
+-- what proc-points each block is reachable from
 procPointAnalysis procPoints g =
   let addPP env id = extendBlockEnv env id ProcPoint
       initProcPoints = foldl addPP emptyBlockEnv (blockSetToList procPoints)
@@ -396,9 +400,9 @@ splitAtProcPoints entry_label callPPs procPoints procMap
      graphEnv <- return $ fold_blocks addBlock emptyBlockEnv g
      -- Build a map from proc point BlockId to labels for their new procedures
      -- Due to common blockification, we may overestimate the set of procpoints.
-     let add_label map pp = return $ addToFM map pp lbl
+     let add_label map pp = return $ Map.insert pp lbl map
            where lbl = if pp == entry then entry_label else blockLbl pp
-     procLabels <- foldM add_label emptyFM
+     procLabels <- foldM add_label Map.empty
                          (filter (elemBlockEnv blocks) (blockSetToList procPoints))
      -- For each procpoint, we need to know the SP offset on entry.
      -- If the procpoint is:
@@ -431,7 +435,7 @@ splitAtProcPoints entry_label callPPs procPoints procMap
                         add_if_pp ti (add_if_pp fi rst)
                       LastOther (LastSwitch _ tbl) -> foldr add_if_pp rst (catMaybes tbl)
                       _ -> rst
-                  add_if_pp id rst = case lookupFM procLabels id of
+                  add_if_pp id rst = case Map.lookup id procLabels of
                                        Just x -> (id, x) : rst
                                        Nothing -> rst
               (jumpEnv, jumpBlocks) <-
@@ -453,14 +457,14 @@ splitAtProcPoints entry_label callPPs procPoints procMap
              CmmProc (CmmInfo gc upd_fr info_tbl) top_l top_args (replacePPIds g)
            else
              CmmProc emptyContInfoTable lbl [] (replacePPIds g)
-           where lbl = expectJust "pp label" $ lookupFM procLabels bid
+           where lbl = expectJust "pp label" $ Map.lookup bid procLabels
          to_proc (bid, g) =
            CmmProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] (replacePPIds g)
-             where lbl = expectJust "pp label" $ lookupFM procLabels bid
+             where lbl = expectJust "pp label" $ Map.lookup bid procLabels
          -- References to procpoint IDs can now be replaced with the infotable's label
          replacePPIds (x, g) = (x, map_nodes id (mapExpMiddle repl) (mapExpLast repl) g)
            where repl e@(CmmLit (CmmBlock bid)) =
-                   case lookupFM procLabels bid of
+                   case Map.lookup bid procLabels of
                      Just l  -> CmmLit (CmmLabel (entryLblToInfoLbl l))
                      Nothing -> e
                  repl e = e