    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"