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 =
        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 = forall a b. (a -> b) -> [a] -> [b]
map forall {b}. Read b => String -> (String, b)
assignment 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
_
            = forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
other forall a. [a] -> [a] -> [a]
++
                      String
" is not a CFG weight parameter. " forall a. [a] -> [a] -> [a]
++
                      String
exampleString
        settings :: String -> [String]
settings String
s
            | (String
s1,String
rest) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
',') String
s
            , forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest
            = [String
s1]
            | (String
s1,String
rest) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
',') String
s
            = String
s1 forall a. a -> [a] -> [a]
: String -> [String]
settings (forall a. Int -> [a] -> [a]
drop Int
1 String
rest)

        assignment :: String -> (String, b)
assignment String
as
            | (String
name, Char
_:String
val) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'=') String
as
            = (String
name,forall a. Read a => String -> a
read String
val)
            | Bool
otherwise
            = forall a. HasCallStack => String -> a
panic forall a b. (a -> b) -> a -> b
$ String
"Invalid CFG weight parameters." forall a. [a] -> [a] -> [a]
++ String
exampleString

        exampleString :: String
exampleString = String
"Example parameters: uncondWeight=1000," forall a. [a] -> [a] -> [a]
++
            String
"condBranchWeight=800,switchWeight=0,callWeight=300" forall a. [a] -> [a] -> [a]
++
            String
",likelyCondWeight=900,unlikelyCondWeight=300" forall a. [a] -> [a] -> [a]
++
            String
",infoTablePenalty=300,backEdgeBonus=400"