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 (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 :: Int
uncondWeight = Int
n}
        update String
"condBranchWeight" Int
n Weights
w =
            Weights
w {condBranchWeight :: Int
condBranchWeight = Int
n}
        update String
"switchWeight" Int
n Weights
w =
            Weights
w {switchWeight :: Int
switchWeight = Int
n}
        update String
"callWeight" Int
n Weights
w =
            Weights
w {callWeight :: Int
callWeight = Int
n}
        update String
"likelyCondWeight" Int
n Weights
w =
            Weights
w {likelyCondWeight :: Int
likelyCondWeight = Int
n}
        update String
"unlikelyCondWeight" Int
n Weights
w =
            Weights
w {unlikelyCondWeight :: Int
unlikelyCondWeight = Int
n}
        update String
"infoTablePenalty" Int
n Weights
w =
            Weights
w {infoTablePenalty :: Int
infoTablePenalty = Int
n}
        update String
"backEdgeBonus" Int
n Weights
w =
            Weights
w {backEdgeBonus :: Int
backEdgeBonus = Int
n}
        update String
other Int
_ Weights
_
            = String -> Weights
forall a. 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 (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. 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"