    -- | 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.Builtin.Uniques
    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
    $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)

    -- | 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
    $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)

    -- | 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
    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."

    -- | 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
    $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 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
    >= 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
    <= 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

            -- 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 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

    -- | 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 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 key elt. UniqFM key elt -> [elt]
    nonDetEltsUFM UniqFM Reg 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 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

    -- | 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 aliased 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 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

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

    -- | powersetLS (list of sets)
    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
      -- See Note [Unique Determinism and code generation]