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 { Weights -> Int uncondWeight :: Int , Weights -> Int condBranchWeight :: Int , Weights -> Int switchWeight :: Int , Weights -> Int callWeight :: Int , Weights -> Int likelyCondWeight :: Int , Weights -> Int unlikelyCondWeight :: Int , Weights -> Int infoTablePenalty :: Int , Weights -> Int backEdgeBonus :: Int } -- | Default edge weights defaultWeights :: Weights defaultWeights :: Weights defaultWeights = Weights { uncondWeight :: Int uncondWeight = Int 1000 , condBranchWeight :: Int condBranchWeight = Int 800 , switchWeight :: Int switchWeight = Int 1 , callWeight :: Int callWeight = -Int 10 , likelyCondWeight :: Int likelyCondWeight = Int 900 , unlikelyCondWeight :: Int unlikelyCondWeight = Int 300 , infoTablePenalty :: Int infoTablePenalty = Int 300 , backEdgeBonus :: Int backEdgeBonus = Int 400 } parseWeights :: String -> Weights -> Weights parseWeights :: String -> Weights -> Weights parseWeights String s Weights oldWeights = (Weights -> (String, Int) -> Weights) -> Weights -> [(String, Int)] -> Weights forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' (\Weights cfg (String n,Int v) -> String -> Int -> Weights -> Weights update String n Int v Weights cfg) Weights oldWeights [(String, Int)] assignments where assignments :: [(String, Int)] assignments = (String -> (String, Int)) -> [String] -> [(String, Int)] forall a b. (a -> b) -> [a] -> [b] map String -> (String, Int) forall {b}. Read b => String -> (String, b) assignment ([String] -> [(String, Int)]) -> [String] -> [(String, Int)] forall a b. (a -> b) -> a -> b $ String -> [String] settings String s update :: String -> Int -> Weights -> Weights update String "uncondWeight" Int n Weights w = Weights w {uncondWeight = n} update String "condBranchWeight" Int n Weights w = Weights w {condBranchWeight = n} update String "switchWeight" Int n Weights w = Weights w {switchWeight = n} update String "callWeight" Int n Weights w = Weights w {callWeight = n} update String "likelyCondWeight" Int n Weights w = Weights w {likelyCondWeight = n} update String "unlikelyCondWeight" Int n Weights w = Weights w {unlikelyCondWeight = n} update String "infoTablePenalty" Int n Weights w = Weights w {infoTablePenalty = n} update String "backEdgeBonus" Int n Weights w = Weights w {backEdgeBonus = n} update String other Int _ Weights _ = String -> Weights forall a. HasCallStack => String -> a panic (String -> Weights) -> String -> Weights forall a b. (a -> b) -> a -> b $ String other String -> String -> String forall a. [a] -> [a] -> [a] ++ String " is not a CFG weight parameter. " String -> String -> String forall a. [a] -> [a] -> [a] ++ String exampleString settings :: String -> [String] settings String s | (String s1,String rest) <- (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char ',') String s , String -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null String rest = [String s1] | (String s1,String rest) <- (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char ',') String s = String s1 String -> [String] -> [String] forall a. a -> [a] -> [a] : String -> [String] settings (Int -> String -> String forall a. Int -> [a] -> [a] drop Int 1 String rest) assignment :: String -> (String, b) assignment String as | (String name, Char _:String val) <- (Char -> Bool) -> String -> (String, String) forall a. (a -> Bool) -> [a] -> ([a], [a]) break (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '=') String as = (String name,String -> b forall a. Read a => String -> a read String val) | Bool otherwise = String -> (String, b) forall a. HasCallStack => String -> a panic (String -> (String, b)) -> String -> (String, b) forall a b. (a -> b) -> a -> b $ String "Invalid CFG weight parameters." String -> String -> String forall a. [a] -> [a] -> [a] ++ String exampleString exampleString :: String exampleString = String "Example parameters: uncondWeight=1000," String -> String -> String forall a. [a] -> [a] -> [a] ++ String "condBranchWeight=800,switchWeight=0,callWeight=300" String -> String -> String forall a. [a] -> [a] -> [a] ++ String ",likelyCondWeight=900,unlikelyCondWeight=300" String -> String -> String forall a. [a] -> [a] -> [a] ++ String ",infoTablePenalty=300,backEdgeBonus=400"