1 files changed, 78 insertions, 0 deletions
diff --git a/compiler/GHC/CmmToAsm/CFG/Weight.hs b/compiler/GHC/CmmToAsm/CFG/Weight.hs
new file mode 100644
index 0000000000..482e857b5a
--- /dev/null
+++ b/compiler/GHC/CmmToAsm/CFG/Weight.hs
@@ -0,0 +1,78 @@
+module GHC.CmmToAsm.CFG.Weight
+   ( Weights (..)
+   , defaultWeights
+   , parseWeights
+   )
+where
+
+import GHC.Prelude
+import GHC.Utils.Panic
+
+-- | Edge weights to use when generating a CFG from CMM
+data Weights = Weights
+   { uncondWeight       :: Int
+   , condBranchWeight   :: Int
+   , switchWeight       :: Int
+   , callWeight         :: Int
+   , likelyCondWeight   :: Int
+   , unlikelyCondWeight :: Int
+   , infoTablePenalty   :: Int
+   , backEdgeBonus      :: Int
+   }
+
+-- | Default edge weights
+defaultWeights :: Weights
+defaultWeights = Weights
+   { uncondWeight       = 1000
+   , condBranchWeight   = 800
+   , switchWeight       = 1
+   , callWeight         = -10
+   , likelyCondWeight   = 900
+   , unlikelyCondWeight = 300
+   , infoTablePenalty   = 300
+   , backEdgeBonus      = 400
+   }
+
+parseWeights :: String -> Weights -> Weights
+parseWeights s oldWeights =
+        foldl' (\cfg (n,v) -> update n v cfg) oldWeights assignments
+    where
+        assignments = map assignment $ settings s
+        update "uncondWeight" n w =
+            w {uncondWeight = n}
+        update "condBranchWeight" n w =
+            w {condBranchWeight = n}
+        update "switchWeight" n w =
+            w {switchWeight = n}
+        update "callWeight" n w =
+            w {callWeight = n}
+        update "likelyCondWeight" n w =
+            w {likelyCondWeight = n}
+        update "unlikelyCondWeight" n w =
+            w {unlikelyCondWeight = n}
+        update "infoTablePenalty" n w =
+            w {infoTablePenalty = n}
+        update "backEdgeBonus" n w =
+            w {backEdgeBonus = n}
+        update other _ _
+            = panic $ other ++
+                      " is not a CFG weight parameter. " ++
+                      exampleString
+        settings s
+            | (s1,rest) <- break (== ',') s
+            , null rest
+            = [s1]
+            | (s1,rest) <- break (== ',') s
+            = s1 : settings (drop 1 rest)
+
+        assignment as
+            | (name, _:val) <- break (== '=') as
+            = (name,read val)
+            | otherwise
+            = panic $ "Invalid CFG weight parameters." ++ exampleString
+
+        exampleString = "Example parameters: uncondWeight=1000," ++
+            "condBranchWeight=800,switchWeight=0,callWeight=300" ++
+            ",likelyCondWeight=900,unlikelyCondWeight=300" ++
+            ",infoTablePenalty=300,backEdgeBonus=400"
+