-- | Utils for calculating general worst, bound, squeese and free, functions.
--
--   as per: "A Generalized Algorithm for Graph-Coloring Register Allocation"
--           Michael Smith, Normal Ramsey, Glenn Holloway.
--           PLDI 2004
--
--   These general versions are not used in GHC proper because they are too slow.
--   Instead, hand written optimised versions are provided for each architecture
--   in MachRegs*.hs
--
--   This code is here because we can test the architecture specific code against
--   it.
--
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.Utils.Monad (concatMapM)


-- Some basic register classes.
--      These aren't necessarily in 1-to-1 correspondence with the allocatable
--      RegClasses in MachRegs.hs
data RegClass
        -- general purpose regs
        = ClassG32      -- 32 bit GPRs
        | ClassG16      -- 16 bit GPRs
        | ClassG8       -- 8  bit GPRs

        -- floating point regs
        | ClassF64      -- 64 bit FPRs
        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
showList :: [RegClass] -> ShowS
$cshowList :: [RegClass] -> ShowS
show :: RegClass -> String
$cshow :: RegClass -> String
showsPrec :: Int -> RegClass -> ShowS
$cshowsPrec :: Int -> RegClass -> ShowS
Show, RegClass -> RegClass -> Bool
(RegClass -> RegClass -> Bool)
-> (RegClass -> RegClass -> Bool) -> Eq RegClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegClass -> RegClass -> Bool
$c/= :: RegClass -> RegClass -> Bool
== :: RegClass -> RegClass -> Bool
$c== :: 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
enumFromThenTo :: RegClass -> RegClass -> RegClass -> [RegClass]
$cenumFromThenTo :: RegClass -> RegClass -> RegClass -> [RegClass]
enumFromTo :: RegClass -> RegClass -> [RegClass]
$cenumFromTo :: RegClass -> RegClass -> [RegClass]
enumFromThen :: RegClass -> RegClass -> [RegClass]
$cenumFromThen :: RegClass -> RegClass -> [RegClass]
enumFrom :: RegClass -> [RegClass]
$cenumFrom :: RegClass -> [RegClass]
fromEnum :: RegClass -> Int
$cfromEnum :: RegClass -> Int
toEnum :: Int -> RegClass
$ctoEnum :: Int -> RegClass
pred :: RegClass -> RegClass
$cpred :: RegClass -> RegClass
succ :: RegClass -> RegClass
$csucc :: RegClass -> RegClass
External instance of the constraint type Enum Int
External instance of the constraint type Show Int
External instance of the constraint type Show Int
External instance of the constraint type Eq Int
External instance of the constraint type Num Int
External instance of the constraint type Ord Int
Enum)


-- | A register of some class
data Reg
        -- a register of some class
        = Reg RegClass Int

        -- a sub-component of one of the other regs
        | 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
showList :: [Reg] -> ShowS
$cshowList :: [Reg] -> ShowS
show :: Reg -> String
$cshow :: Reg -> String
showsPrec :: Int -> Reg -> ShowS
$cshowsPrec :: Int -> Reg -> ShowS
External instance of the constraint type Show Int
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show RegClass
Instance of class: Show of the constraint type Show RegSub
Instance of class: Show of the constraint type Show Reg
Show, Reg -> Reg -> Bool
(Reg -> Reg -> Bool) -> (Reg -> Reg -> Bool) -> Eq Reg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reg -> Reg -> Bool
$c/= :: Reg -> Reg -> Bool
== :: Reg -> Reg -> Bool
$c== :: Reg -> Reg -> Bool
External instance of the constraint type Eq Int
Instance of class: Eq of the constraint type Eq RegClass
Instance of class: Eq of the constraint type Eq RegSub
Instance of class: Eq of the constraint type Eq Reg
Eq)


-- | so we can put regs in UniqSets
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
Instance of class: Enum of the constraint type Enum RegClass
fromEnum RegClass
c Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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
Instance of class: Enum of the constraint type Enum RegSub
fromEnum RegSub
s Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ RegClass -> Int
forall a. Enum a => a -> Int
Instance of class: Enum of the constraint type Enum RegClass
fromEnum RegClass
c Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ 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."


-- | A subcomponent of another register
data RegSub
        = SubL16        -- lowest 16 bits
        | SubL8         -- lowest  8 bits
        | SubL8H        -- second lowest 8 bits
        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
showList :: [RegSub] -> ShowS
$cshowList :: [RegSub] -> ShowS
show :: RegSub -> String
$cshow :: RegSub -> String
showsPrec :: Int -> RegSub -> ShowS
$cshowsPrec :: Int -> 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
enumFromThenTo :: RegSub -> RegSub -> RegSub -> [RegSub]
$cenumFromThenTo :: RegSub -> RegSub -> RegSub -> [RegSub]
enumFromTo :: RegSub -> RegSub -> [RegSub]
$cenumFromTo :: RegSub -> RegSub -> [RegSub]
enumFromThen :: RegSub -> RegSub -> [RegSub]
$cenumFromThen :: RegSub -> RegSub -> [RegSub]
enumFrom :: RegSub -> [RegSub]
$cenumFrom :: RegSub -> [RegSub]
fromEnum :: RegSub -> Int
$cfromEnum :: RegSub -> Int
toEnum :: Int -> RegSub
$ctoEnum :: Int -> RegSub
pred :: RegSub -> RegSub
$cpred :: RegSub -> RegSub
succ :: RegSub -> RegSub
$csucc :: RegSub -> RegSub
External instance of the constraint type Show Int
External instance of the constraint type Enum Int
External instance of the constraint type Show Int
External instance of the constraint type Eq Int
External instance of the constraint type Num Int
External instance of the constraint type Ord Int
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
min :: RegSub -> RegSub -> RegSub
$cmin :: RegSub -> RegSub -> RegSub
max :: RegSub -> RegSub -> RegSub
$cmax :: RegSub -> RegSub -> RegSub
>= :: RegSub -> RegSub -> Bool
$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
compare :: RegSub -> RegSub -> Ordering
$ccompare :: RegSub -> RegSub -> Ordering
Instance of class: Eq of the constraint type Eq RegSub
Instance of class: Eq of the constraint type Eq RegSub
Instance of class: Ord of the constraint type Ord RegSub
Ord, RegSub -> RegSub -> Bool
(RegSub -> RegSub -> Bool)
-> (RegSub -> RegSub -> Bool) -> Eq RegSub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegSub -> RegSub -> Bool
$c/= :: RegSub -> RegSub -> Bool
== :: RegSub -> RegSub -> Bool
$c== :: RegSub -> RegSub -> Bool
Eq)


-- | Worst case displacement
--
--      a node N of classN has some number of neighbors,
--      all of which are from classC.
--
--      (worst neighbors classN classC) is the maximum number of potential
--      colors for N that can be lost by coloring its neighbors.
--
-- This should be hand coded/cached for each particular architecture,
--      because the compute time is very long..
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
                        -- This is non-deterministic but we do not
                        -- currently support deterministic code-generation.
                        -- See Note [Unique Determinism and code generation]

        -- all the regs in classes N, C
        regsN :: UniqSet Reg
regsN           = RegClass -> UniqSet Reg
regsOfClass RegClass
classN
        regsC :: UniqSet Reg
regsC           = RegClass -> UniqSet Reg
regsOfClass RegClass
classC

        -- all the possible subsets of c which have size < m
        regsS :: [UniqSet Reg]
regsS           = (UniqSet Reg -> Bool) -> [UniqSet Reg] -> [UniqSet Reg]
forall a. (a -> Bool) -> [a] -> [a]
filter (\UniqSet Reg
s -> UniqSet Reg -> Int
forall a. UniqSet a -> Int
sizeUniqSet UniqSet Reg
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
>= Int
1
                                     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
External instance of the constraint type Ord Int
<= 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]
Instance of class: Uniquable of the constraint type Uniquable Reg
powersetLS UniqSet Reg
regsC

        -- for each of the subsets of C, the regs which conflict
        -- with posiblities for N
        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 (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
External instance of the constraint type Ord Int
External instance of the constraint type Foldable []
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


-- | For a node N of classN and neighbors of classesC
--      (bound classN classesC) is the maximum number of potential
--      colors for N that can be lost by coloring its neighbors.
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 -> UniqSet Reg
regAliasS UniqFM 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]
forall elt. UniqFM elt -> [elt]
nonDetEltsUFM UniqFM Reg
regs
                        -- See Note [Unique Determinism and code generation]

        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 -> UniqSet Reg
regAliasS (UniqFM Reg -> UniqSet Reg)
-> (RegClass -> UniqFM Reg) -> RegClass -> UniqSet Reg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniqSet Reg -> UniqFM Reg
forall a. UniqSet a -> UniqFM a
getUniqSet (UniqSet Reg -> UniqFM Reg)
-> (RegClass -> UniqSet Reg) -> RegClass -> UniqFM 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


-- | The total squeese on a particular node with a list of neighbors.
--
--   A version of this should be constructed for each particular architecture,
--   possibly including uses of bound, so that alised registers don't get
--   counted twice, as per the paper.
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 (t :: * -> *) a. (Foldable t, Num a) => t a -> a
External instance of the constraint type Num Int
External instance of the constraint type Foldable []
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


-- | powerset (for lists)
powersetL :: [a] -> [[a]]
powersetL :: [a] -> [[a]]
powersetL       = (a -> [[a]]) -> [a] -> [[a]]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
External instance of the constraint type Monad []
concatMapM (\a
x -> [[],[a
x]])


-- | powersetLS (list of sets)
powersetLS :: Uniquable a => UniqSet a -> [UniqSet a]
powersetLS :: 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
Evidence bound by a type signature of the constraint type Uniquable 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
  -- See Note [Unique Determinism and code generation]