module GHC.CmmToAsm.Reg.Graph.Base (
RegClass(..),
Reg(..),
RegSub(..),
worst,
bound,
squeese
) where
import GHC.Prelude
import GHC.Types.Unique.Set
import GHC.Types.Unique.FM
import GHC.Types.Unique
import GHC.Builtin.Uniques
import GHC.Utils.Monad (concatMapM)
data RegClass
= ClassG32
| ClassG16
| ClassG8
| ClassF64
deriving (Int -> RegClass -> ShowS
[RegClass] -> ShowS
RegClass -> String
(Int -> RegClass -> ShowS)
-> (RegClass -> String) -> ([RegClass] -> ShowS) -> Show RegClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegClass -> ShowS
showsPrec :: Int -> RegClass -> ShowS
$cshow :: RegClass -> String
show :: RegClass -> String
$cshowList :: [RegClass] -> ShowS
showList :: [RegClass] -> ShowS
Show, RegClass -> RegClass -> Bool
(RegClass -> RegClass -> Bool)
-> (RegClass -> RegClass -> Bool) -> Eq RegClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegClass -> RegClass -> Bool
== :: RegClass -> RegClass -> Bool
$c/= :: RegClass -> RegClass -> Bool
/= :: RegClass -> RegClass -> Bool
Eq, Int -> RegClass
RegClass -> Int
RegClass -> [RegClass]
RegClass -> RegClass
RegClass -> RegClass -> [RegClass]
RegClass -> RegClass -> RegClass -> [RegClass]
(RegClass -> RegClass)
-> (RegClass -> RegClass)
-> (Int -> RegClass)
-> (RegClass -> Int)
-> (RegClass -> [RegClass])
-> (RegClass -> RegClass -> [RegClass])
-> (RegClass -> RegClass -> [RegClass])
-> (RegClass -> RegClass -> RegClass -> [RegClass])
-> Enum RegClass
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RegClass -> RegClass
succ :: RegClass -> RegClass
$cpred :: RegClass -> RegClass
pred :: RegClass -> RegClass
$ctoEnum :: Int -> RegClass
toEnum :: Int -> RegClass
$cfromEnum :: RegClass -> Int
fromEnum :: RegClass -> Int
$cenumFrom :: RegClass -> [RegClass]
enumFrom :: RegClass -> [RegClass]
$cenumFromThen :: RegClass -> RegClass -> [RegClass]
enumFromThen :: RegClass -> RegClass -> [RegClass]
$cenumFromTo :: RegClass -> RegClass -> [RegClass]
enumFromTo :: RegClass -> RegClass -> [RegClass]
$cenumFromThenTo :: RegClass -> RegClass -> RegClass -> [RegClass]
enumFromThenTo :: RegClass -> RegClass -> RegClass -> [RegClass]
Enum)
data Reg
= Reg RegClass Int
| RegSub RegSub Reg
deriving (Int -> Reg -> ShowS
[Reg] -> ShowS
Reg -> String
(Int -> Reg -> ShowS)
-> (Reg -> String) -> ([Reg] -> ShowS) -> Show Reg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reg -> ShowS
showsPrec :: Int -> Reg -> ShowS
$cshow :: Reg -> String
show :: Reg -> String
$cshowList :: [Reg] -> ShowS
showList :: [Reg] -> ShowS
Show, Reg -> Reg -> Bool
(Reg -> Reg -> Bool) -> (Reg -> Reg -> Bool) -> Eq Reg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reg -> Reg -> Bool
== :: Reg -> Reg -> Bool
$c/= :: Reg -> Reg -> Bool
/= :: Reg -> Reg -> Bool
Eq)
instance Uniquable Reg where
getUnique :: Reg -> Unique
getUnique (Reg RegClass
c Int
i)
= Int -> Unique
mkRegSingleUnique
(Int -> Unique) -> Int -> Unique
forall a b. (a -> b) -> a -> b
$ RegClass -> Int
forall a. Enum a => a -> Int
fromEnum RegClass
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
getUnique (RegSub RegSub
s (Reg RegClass
c Int
i))
= Int -> Unique
mkRegSubUnique
(Int -> Unique) -> Int -> Unique
forall a b. (a -> b) -> a -> b
$ RegSub -> Int
forall a. Enum a => a -> Int
fromEnum RegSub
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ RegClass -> Int
forall a. Enum a => a -> Int
fromEnum RegClass
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
getUnique (RegSub RegSub
_ (RegSub RegSub
_ Reg
_))
= String -> Unique
forall a. HasCallStack => String -> a
error String
"RegArchBase.getUnique: can't have a sub-reg of a sub-reg."
data RegSub
= SubL16
| SubL8
| SubL8H
deriving (Int -> RegSub -> ShowS
[RegSub] -> ShowS
RegSub -> String
(Int -> RegSub -> ShowS)
-> (RegSub -> String) -> ([RegSub] -> ShowS) -> Show RegSub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegSub -> ShowS
showsPrec :: Int -> RegSub -> ShowS
$cshow :: RegSub -> String
show :: RegSub -> String
$cshowList :: [RegSub] -> ShowS
showList :: [RegSub] -> ShowS
Show, Int -> RegSub
RegSub -> Int
RegSub -> [RegSub]
RegSub -> RegSub
RegSub -> RegSub -> [RegSub]
RegSub -> RegSub -> RegSub -> [RegSub]
(RegSub -> RegSub)
-> (RegSub -> RegSub)
-> (Int -> RegSub)
-> (RegSub -> Int)
-> (RegSub -> [RegSub])
-> (RegSub -> RegSub -> [RegSub])
-> (RegSub -> RegSub -> [RegSub])
-> (RegSub -> RegSub -> RegSub -> [RegSub])
-> Enum RegSub
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RegSub -> RegSub
succ :: RegSub -> RegSub
$cpred :: RegSub -> RegSub
pred :: RegSub -> RegSub
$ctoEnum :: Int -> RegSub
toEnum :: Int -> RegSub
$cfromEnum :: RegSub -> Int
fromEnum :: RegSub -> Int
$cenumFrom :: RegSub -> [RegSub]
enumFrom :: RegSub -> [RegSub]
$cenumFromThen :: RegSub -> RegSub -> [RegSub]
enumFromThen :: RegSub -> RegSub -> [RegSub]
$cenumFromTo :: RegSub -> RegSub -> [RegSub]
enumFromTo :: RegSub -> RegSub -> [RegSub]
$cenumFromThenTo :: RegSub -> RegSub -> RegSub -> [RegSub]
enumFromThenTo :: RegSub -> RegSub -> RegSub -> [RegSub]
Enum, Eq RegSub
Eq RegSub =>
(RegSub -> RegSub -> Ordering)
-> (RegSub -> RegSub -> Bool)
-> (RegSub -> RegSub -> Bool)
-> (RegSub -> RegSub -> Bool)
-> (RegSub -> RegSub -> Bool)
-> (RegSub -> RegSub -> RegSub)
-> (RegSub -> RegSub -> RegSub)
-> Ord RegSub
RegSub -> RegSub -> Bool
RegSub -> RegSub -> Ordering
RegSub -> RegSub -> RegSub
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RegSub -> RegSub -> Ordering
compare :: RegSub -> RegSub -> Ordering
$c< :: RegSub -> RegSub -> Bool
< :: RegSub -> RegSub -> Bool
$c<= :: RegSub -> RegSub -> Bool
<= :: RegSub -> RegSub -> Bool
$c> :: RegSub -> RegSub -> Bool
> :: RegSub -> RegSub -> Bool
$c>= :: RegSub -> RegSub -> Bool
>= :: RegSub -> RegSub -> Bool
$cmax :: RegSub -> RegSub -> RegSub
max :: RegSub -> RegSub -> RegSub
$cmin :: RegSub -> RegSub -> RegSub
min :: RegSub -> RegSub -> RegSub
Ord, RegSub -> RegSub -> Bool
(RegSub -> RegSub -> Bool)
-> (RegSub -> RegSub -> Bool) -> Eq RegSub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegSub -> RegSub -> Bool
== :: RegSub -> RegSub -> Bool
$c/= :: RegSub -> RegSub -> Bool
/= :: RegSub -> RegSub -> Bool
Eq)
worst :: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg)
-> Int -> RegClass -> RegClass -> Int
worst :: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg) -> Int -> RegClass -> RegClass -> Int
worst RegClass -> UniqSet Reg
regsOfClass Reg -> UniqSet Reg
regAlias Int
neighbors RegClass
classN RegClass
classC
= let regAliasS :: UniqSet Reg -> UniqSet Reg
regAliasS UniqSet Reg
regs = [UniqSet Reg] -> UniqSet Reg
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
([UniqSet Reg] -> UniqSet Reg) -> [UniqSet Reg] -> UniqSet Reg
forall a b. (a -> b) -> a -> b
$ (Reg -> UniqSet Reg) -> [Reg] -> [UniqSet Reg]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> UniqSet Reg
regAlias
([Reg] -> [UniqSet Reg]) -> [Reg] -> [UniqSet Reg]
forall a b. (a -> b) -> a -> b
$ UniqSet Reg -> [Reg]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet Reg
regs
regsN :: UniqSet Reg
regsN = RegClass -> UniqSet Reg
regsOfClass RegClass
classN
regsC :: UniqSet Reg
regsC = RegClass -> UniqSet Reg
regsOfClass RegClass
classC
regsS :: [UniqSet Reg]
regsS = (UniqSet Reg -> Bool) -> [UniqSet Reg] -> [UniqSet Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (\UniqSet Reg
s -> Bool -> Bool
not (UniqSet Reg -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet UniqSet Reg
s)
Bool -> Bool -> Bool
&& UniqSet Reg -> Int
forall a. UniqSet a -> Int
sizeUniqSet UniqSet Reg
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
neighbors)
([UniqSet Reg] -> [UniqSet Reg]) -> [UniqSet Reg] -> [UniqSet Reg]
forall a b. (a -> b) -> a -> b
$ UniqSet Reg -> [UniqSet Reg]
forall a. Uniquable a => UniqSet a -> [UniqSet a]
powersetLS UniqSet Reg
regsC
regsS_conflict :: [UniqSet Reg]
regsS_conflict
= (UniqSet Reg -> UniqSet Reg) -> [UniqSet Reg] -> [UniqSet Reg]
forall a b. (a -> b) -> [a] -> [b]
map (\UniqSet Reg
s -> UniqSet Reg -> UniqSet Reg -> UniqSet Reg
forall a. UniqSet a -> UniqSet a -> UniqSet a
intersectUniqSets UniqSet Reg
regsN (UniqSet Reg -> UniqSet Reg
regAliasS UniqSet Reg
s)) [UniqSet Reg]
regsS
in [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (UniqSet Reg -> Int) -> [UniqSet Reg] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map UniqSet Reg -> Int
forall a. UniqSet a -> Int
sizeUniqSet ([UniqSet Reg] -> [Int]) -> [UniqSet Reg] -> [Int]
forall a b. (a -> b) -> a -> b
$ [UniqSet Reg]
regsS_conflict
bound :: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg)
-> RegClass -> [RegClass] -> Int
bound :: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg) -> RegClass -> [RegClass] -> Int
bound RegClass -> UniqSet Reg
regsOfClass Reg -> UniqSet Reg
regAlias RegClass
classN [RegClass]
classesC
= let regAliasS :: UniqFM Reg Reg -> UniqSet Reg
regAliasS UniqFM Reg Reg
regs = [UniqSet Reg] -> UniqSet Reg
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
([UniqSet Reg] -> UniqSet Reg) -> [UniqSet Reg] -> UniqSet Reg
forall a b. (a -> b) -> a -> b
$ (Reg -> UniqSet Reg) -> [Reg] -> [UniqSet Reg]
forall a b. (a -> b) -> [a] -> [b]
map Reg -> UniqSet Reg
regAlias
([Reg] -> [UniqSet Reg]) -> [Reg] -> [UniqSet Reg]
forall a b. (a -> b) -> a -> b
$ UniqFM Reg Reg -> [Reg]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM Reg Reg
regs
regsC_aliases :: UniqSet Reg
regsC_aliases
= [UniqSet Reg] -> UniqSet Reg
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
([UniqSet Reg] -> UniqSet Reg) -> [UniqSet Reg] -> UniqSet Reg
forall a b. (a -> b) -> a -> b
$ (RegClass -> UniqSet Reg) -> [RegClass] -> [UniqSet Reg]
forall a b. (a -> b) -> [a] -> [b]
map (UniqFM Reg Reg -> UniqSet Reg
regAliasS (UniqFM Reg Reg -> UniqSet Reg)
-> (RegClass -> UniqFM Reg Reg) -> RegClass -> UniqSet Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqSet Reg -> UniqFM Reg Reg
forall a. UniqSet a -> UniqFM a a
getUniqSet (UniqSet Reg -> UniqFM Reg Reg)
-> (RegClass -> UniqSet Reg) -> RegClass -> UniqFM Reg Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegClass -> UniqSet Reg
regsOfClass) [RegClass]
classesC
overlap :: UniqSet Reg
overlap = UniqSet Reg -> UniqSet Reg -> UniqSet Reg
forall a. UniqSet a -> UniqSet a -> UniqSet a
intersectUniqSets (RegClass -> UniqSet Reg
regsOfClass RegClass
classN) UniqSet Reg
regsC_aliases
in UniqSet Reg -> Int
forall a. UniqSet a -> Int
sizeUniqSet UniqSet Reg
overlap
squeese :: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg)
-> RegClass -> [(Int, RegClass)] -> Int
squeese :: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg) -> RegClass -> [(Int, RegClass)] -> Int
squeese RegClass -> UniqSet Reg
regsOfClass Reg -> UniqSet Reg
regAlias RegClass
classN [(Int, RegClass)]
countCs
= [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, RegClass) -> Int) -> [(Int, RegClass)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, RegClass
classC) -> (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg) -> Int -> RegClass -> RegClass -> Int
worst RegClass -> UniqSet Reg
regsOfClass Reg -> UniqSet Reg
regAlias Int
i RegClass
classN RegClass
classC)
([(Int, RegClass)] -> [Int]) -> [(Int, RegClass)] -> [Int]
forall a b. (a -> b) -> a -> b
$ [(Int, RegClass)]
countCs
powersetL :: [a] -> [[a]]
powersetL :: forall a. [a] -> [[a]]
powersetL = (a -> [[a]]) -> [a] -> [[a]]
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Traversable f) =>
(a -> m [b]) -> f a -> m [b]
concatMapM (\a
x -> [[],[a
x]])
powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
powersetLS :: forall a. Uniquable a => UniqSet a -> [UniqSet a]
powersetLS UniqSet a
s = ([a] -> UniqSet a) -> [[a]] -> [UniqSet a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> UniqSet a
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([[a]] -> [UniqSet a]) -> [[a]] -> [UniqSet a]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
powersetL ([a] -> [[a]]) -> [a] -> [[a]]
forall a b. (a -> b) -> a -> b
$ UniqSet a -> [a]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet UniqSet a
s