{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Cmm.Switch (
     SwitchTargets,
     mkSwitchTargets,
     switchTargetsCases, switchTargetsDefault, switchTargetsRange, switchTargetsSigned,
     mapSwitchTargets, switchTargetsToTable, switchTargetsFallThrough,
     switchTargetsToList, eqSwitchTargetWith,

     SwitchPlan(..),
     targetSupportsSwitch,
     createSwitchPlan,
  ) where

import GHC.Prelude

import GHC.Utils.Outputable
import GHC.Driver.Session
import GHC.Cmm.Dataflow.Label (Label)

import Data.Maybe
import Data.List (groupBy)
import Data.Function (on)
import qualified Data.Map as M

-- Note [Cmm Switches, the general plan]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Compiling a high-level switch statement, as it comes out of a STG case
-- expression, for example, allows for a surprising amount of design decisions.
-- Therefore, we cleanly separated this from the Stg → Cmm transformation, as
-- well as from the actual code generation.
--
-- The overall plan is:
--  * The Stg → Cmm transformation creates a single `SwitchTargets` in
--    emitSwitch and emitCmmLitSwitch in GHC.StgToCmm.Utils.
--    At this stage, they are unsuitable for code generation.
--  * A dedicated Cmm transformation (GHC.Cmm.Switch.Implement) replaces these
--    switch statements with code that is suitable for code generation, i.e.
--    a nice balanced tree of decisions with dense jump tables in the leafs.
--    The actual planning of this tree is performed in pure code in createSwitchPlan
--    in this module. See Note [createSwitchPlan].
--  * The actual code generation will not do any further processing and
--    implement each CmmSwitch with a jump tables.
--
-- When compiling to LLVM or C, GHC.Cmm.Switch.Implement leaves the switch
-- statements alone, as we can turn a SwitchTargets value into a nice
-- switch-statement in LLVM resp. C, and leave the rest to the compiler.
--
-- See Note [GHC.Cmm.Switch vs. GHC.Cmm.Switch.Implement] why the two module are
-- separated.

-----------------------------------------------------------------------------
-- Note [Magic Constants in GHC.Cmm.Switch]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- There are a lot of heuristics here that depend on magic values where it is
-- hard to determine the "best" value (for whatever that means). These are the
-- magic values:

-- | Number of consecutive default values allowed in a jump table. If there are
-- more of them, the jump tables are split.
--
-- Currently 7, as it costs 7 words of additional code when a jump table is
-- split (at least on x64, determined experimentally).
maxJumpTableHole :: Integer
maxJumpTableHole :: Integer
maxJumpTableHole = Integer
7

-- | Minimum size of a jump table. If the number is smaller, the switch is
-- implemented using conditionals.
-- Currently 5, because an if-then-else tree of 4 values is nice and compact.
minJumpTableSize :: Int
minJumpTableSize :: Int
minJumpTableSize = Int
5

-- | Minimum non-zero offset for a jump table. See Note [Jump Table Offset].
minJumpTableOffset :: Integer
minJumpTableOffset :: Integer
minJumpTableOffset = Integer
2


-----------------------------------------------------------------------------
-- Switch Targets

-- Note [SwitchTargets]
-- ~~~~~~~~~~~~~~~~~~~~
--
-- The branches of a switch are stored in a SwitchTargets, which consists of an
-- (optional) default jump target, and a map from values to jump targets.
--
-- If the default jump target is absent, the behaviour of the switch outside the
-- values of the map is undefined.
--
-- We use an Integer for the keys the map so that it can be used in switches on
-- unsigned as well as signed integers.
--
-- The map may be empty (we prune out-of-range branches here, so it could be us
-- emptying it).
--
-- Before code generation, the table needs to be brought into a form where all
-- entries are non-negative, so that it can be compiled into a jump table.
-- See switchTargetsToTable.


-- | A value of type SwitchTargets contains the alternatives for a 'CmmSwitch'
-- value, and knows whether the value is signed, the possible range, an
-- optional default value and a map from values to jump labels.
data SwitchTargets =
    SwitchTargets
        Bool                       -- Signed values
        (Integer, Integer)         -- Range
        (Maybe Label)              -- Default value
        (M.Map Integer Label)      -- The branches
    deriving (Int -> SwitchTargets -> ShowS
[SwitchTargets] -> ShowS
SwitchTargets -> String
(Int -> SwitchTargets -> ShowS)
-> (SwitchTargets -> String)
-> ([SwitchTargets] -> ShowS)
-> Show SwitchTargets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwitchTargets] -> ShowS
$cshowList :: [SwitchTargets] -> ShowS
show :: SwitchTargets -> String
$cshow :: SwitchTargets -> String
showsPrec :: Int -> SwitchTargets -> ShowS
$cshowsPrec :: Int -> SwitchTargets -> ShowS
External instance of the constraint type Show Label
External instance of the constraint type Show Integer
External instance of the constraint type forall k a. (Show k, Show a) => Show (Map k a)
External instance of the constraint type Show Label
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type Show Integer
External instance of the constraint type Show Integer
External instance of the constraint type forall a b. (Show a, Show b) => Show (a, b)
External instance of the constraint type Show Bool
External instance of the constraint type Ord Int
Show, SwitchTargets -> SwitchTargets -> Bool
(SwitchTargets -> SwitchTargets -> Bool)
-> (SwitchTargets -> SwitchTargets -> Bool) -> Eq SwitchTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SwitchTargets -> SwitchTargets -> Bool
$c/= :: SwitchTargets -> SwitchTargets -> Bool
== :: SwitchTargets -> SwitchTargets -> Bool
$c== :: SwitchTargets -> SwitchTargets -> Bool
External instance of the constraint type forall k a. (Eq k, Eq a) => Eq (Map k a)
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq Integer
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Integer
External instance of the constraint type Eq Label
Eq)

-- | The smart constructor mkSwitchTargets normalises the map a bit:
--  * No entries outside the range
--  * No entries equal to the default
--  * No default if all elements have explicit values
mkSwitchTargets :: Bool -> (Integer, Integer) -> Maybe Label -> M.Map Integer Label -> SwitchTargets
mkSwitchTargets :: Bool
-> (Integer, Integer)
-> Maybe Label
-> Map Integer Label
-> SwitchTargets
mkSwitchTargets Bool
signed range :: (Integer, Integer)
range@(Integer
lo,Integer
hi) Maybe Label
mbdef Map Integer Label
ids
    = Bool
-> (Integer, Integer)
-> Maybe Label
-> Map Integer Label
-> SwitchTargets
SwitchTargets Bool
signed (Integer, Integer)
range Maybe Label
mbdef' Map Integer Label
ids'
  where
    ids' :: Map Integer Label
ids' = Map Integer Label -> Map Integer Label
dropDefault (Map Integer Label -> Map Integer Label)
-> Map Integer Label -> Map Integer Label
forall a b. (a -> b) -> a -> b
$ Map Integer Label -> Map Integer Label
restrict Map Integer Label
ids
    mbdef' :: Maybe Label
mbdef' | Bool
defaultNeeded = Maybe Label
mbdef
           | Bool
otherwise     = Maybe Label
forall a. Maybe a
Nothing

    -- Drop entries outside the range, if there is a range
    restrict :: Map Integer Label -> Map Integer Label
restrict = (Integer, Integer) -> Map Integer Label -> Map Integer Label
forall b. (Integer, Integer) -> Map Integer b -> Map Integer b
restrictMap (Integer
lo,Integer
hi)

    -- Drop entries that equal the default, if there is a default
    dropDefault :: Map Integer Label -> Map Integer Label
dropDefault | Just Label
l <- Maybe Label
mbdef = (Label -> Bool) -> Map Integer Label -> Map Integer Label
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Label
/= Label
l)
                | Bool
otherwise       = Map Integer Label -> Map Integer Label
forall a. a -> a
id

    -- Check if the default is still needed
    defaultNeeded :: Bool
defaultNeeded = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral Int
fromIntegral (Map Integer Label -> Int
forall k a. Map k a -> Int
M.size Map Integer Label
ids') Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
/= Integer
hiInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
loInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
1


-- | Changes all labels mentioned in the SwitchTargets value
mapSwitchTargets :: (Label -> Label) -> SwitchTargets -> SwitchTargets
mapSwitchTargets :: (Label -> Label) -> SwitchTargets -> SwitchTargets
mapSwitchTargets Label -> Label
f (SwitchTargets Bool
signed (Integer, Integer)
range Maybe Label
mbdef Map Integer Label
branches)
    = Bool
-> (Integer, Integer)
-> Maybe Label
-> Map Integer Label
-> SwitchTargets
SwitchTargets Bool
signed (Integer, Integer)
range ((Label -> Label) -> Maybe Label -> Maybe Label
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap Label -> Label
f Maybe Label
mbdef) ((Label -> Label) -> Map Integer Label -> Map Integer Label
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall k. Functor (Map k)
fmap Label -> Label
f Map Integer Label
branches)

-- | Returns the list of non-default branches of the SwitchTargets value
switchTargetsCases :: SwitchTargets -> [(Integer, Label)]
switchTargetsCases :: SwitchTargets -> [(Integer, Label)]
switchTargetsCases (SwitchTargets Bool
_ (Integer, Integer)
_ Maybe Label
_ Map Integer Label
branches) = Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toList Map Integer Label
branches

-- | Return the default label of the SwitchTargets value
switchTargetsDefault :: SwitchTargets -> Maybe Label
switchTargetsDefault :: SwitchTargets -> Maybe Label
switchTargetsDefault (SwitchTargets Bool
_ (Integer, Integer)
_ Maybe Label
mbdef Map Integer Label
_) = Maybe Label
mbdef

-- | Return the range of the SwitchTargets value
switchTargetsRange :: SwitchTargets -> (Integer, Integer)
switchTargetsRange :: SwitchTargets -> (Integer, Integer)
switchTargetsRange (SwitchTargets Bool
_ (Integer, Integer)
range Maybe Label
_ Map Integer Label
_) = (Integer, Integer)
range

-- | Return whether this is used for a signed value
switchTargetsSigned :: SwitchTargets -> Bool
switchTargetsSigned :: SwitchTargets -> Bool
switchTargetsSigned (SwitchTargets Bool
signed (Integer, Integer)
_ Maybe Label
_ Map Integer Label
_) = Bool
signed

-- | switchTargetsToTable creates a dense jump table, usable for code generation.
--
-- Also returns an offset to add to the value; the list is 0-based on the
-- result of that addition.
--
-- The conversion from Integer to Int is a bit of a wart, as the actual
-- scrutinee might be an unsigned word, but it just works, due to wrap-around
-- arithmetic (as verified by the CmmSwitchTest test case).
switchTargetsToTable :: SwitchTargets -> (Int, [Maybe Label])
switchTargetsToTable :: SwitchTargets -> (Int, [Maybe Label])
switchTargetsToTable (SwitchTargets Bool
_ (Integer
lo,Integer
hi) Maybe Label
mbdef Map Integer Label
branches)
    = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Integer
fromIntegral (-Integer
start), [ Integer -> Maybe Label
labelFor Integer
i | Integer
i <- [Integer
start..Integer
hi] ])
  where
    labelFor :: Integer -> Maybe Label
labelFor Integer
i = case Integer -> Map Integer Label -> Maybe Label
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type Ord Integer
M.lookup Integer
i Map Integer Label
branches of Just Label
l -> Label -> Maybe Label
forall a. a -> Maybe a
Just Label
l
                                             Maybe Label
Nothing -> Maybe Label
mbdef
    start :: Integer
start | Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
>= Integer
0 Bool -> Bool -> Bool
&& Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
< Integer
minJumpTableOffset  = Integer
0  -- See Note [Jump Table Offset]
          | Bool
otherwise                           = Integer
lo

-- Note [Jump Table Offset]
-- ~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Usually, the code for a jump table starting at x will first subtract x from
-- the value, to avoid a large amount of empty entries. But if x is very small,
-- the extra entries are no worse than the subtraction in terms of code size, and
-- not having to do the subtraction is quicker.
--
-- I.e. instead of
--     _u20N:
--             leaq -1(%r14),%rax
--             jmp *_n20R(,%rax,8)
--     _n20R:
--             .quad   _c20p
--             .quad   _c20q
-- do
--     _u20N:
--             jmp *_n20Q(,%r14,8)
--
--     _n20Q:
--             .quad   0
--             .quad   _c20p
--             .quad   _c20q
--             .quad   _c20r

-- | The list of all labels occurring in the SwitchTargets value.
switchTargetsToList :: SwitchTargets -> [Label]
switchTargetsToList :: SwitchTargets -> [Label]
switchTargetsToList (SwitchTargets Bool
_ (Integer, Integer)
_ Maybe Label
mbdef Map Integer Label
branches)
    = Maybe Label -> [Label]
forall a. Maybe a -> [a]
maybeToList Maybe Label
mbdef [Label] -> [Label] -> [Label]
forall a. [a] -> [a] -> [a]
++ Map Integer Label -> [Label]
forall k a. Map k a -> [a]
M.elems Map Integer Label
branches

-- | Groups cases with equal targets, suitable for pretty-printing to a
-- c-like switch statement with fall-through semantics.
switchTargetsFallThrough :: SwitchTargets -> ([([Integer], Label)], Maybe Label)
switchTargetsFallThrough :: SwitchTargets -> ([([Integer], Label)], Maybe Label)
switchTargetsFallThrough (SwitchTargets Bool
_ (Integer, Integer)
_ Maybe Label
mbdef Map Integer Label
branches) = ([([Integer], Label)]
groups, Maybe Label
mbdef)
  where
    groups :: [([Integer], Label)]
groups = ([(Integer, Label)] -> ([Integer], Label))
-> [[(Integer, Label)]] -> [([Integer], Label)]
forall a b. (a -> b) -> [a] -> [b]
map (\[(Integer, Label)]
xs -> (((Integer, Label) -> Integer) -> [(Integer, Label)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Label) -> Integer
forall a b. (a, b) -> a
fst [(Integer, Label)]
xs, (Integer, Label) -> Label
forall a b. (a, b) -> b
snd ([(Integer, Label)] -> (Integer, Label)
forall a. [a] -> a
head [(Integer, Label)]
xs))) ([[(Integer, Label)]] -> [([Integer], Label)])
-> [[(Integer, Label)]] -> [([Integer], Label)]
forall a b. (a -> b) -> a -> b
$
             ((Integer, Label) -> (Integer, Label) -> Bool)
-> [(Integer, Label)] -> [[(Integer, Label)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Label
(==) (Label -> Label -> Bool)
-> ((Integer, Label) -> Label)
-> (Integer, Label)
-> (Integer, Label)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Integer, Label) -> Label
forall a b. (a, b) -> b
snd) ([(Integer, Label)] -> [[(Integer, Label)]])
-> [(Integer, Label)] -> [[(Integer, Label)]]
forall a b. (a -> b) -> a -> b
$
             Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toList Map Integer Label
branches

-- | Custom equality helper, needed for "GHC.Cmm.CommonBlockElim"
eqSwitchTargetWith :: (Label -> Label -> Bool) -> SwitchTargets -> SwitchTargets -> Bool
eqSwitchTargetWith :: (Label -> Label -> Bool) -> SwitchTargets -> SwitchTargets -> Bool
eqSwitchTargetWith Label -> Label -> Bool
eq (SwitchTargets Bool
signed1 (Integer, Integer)
range1 Maybe Label
mbdef1 Map Integer Label
ids1) (SwitchTargets Bool
signed2 (Integer, Integer)
range2 Maybe Label
mbdef2 Map Integer Label
ids2) =
    Bool
signed1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Bool
== Bool
signed2 Bool -> Bool -> Bool
&& (Integer, Integer)
range1 (Integer, Integer) -> (Integer, Integer) -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a b. (Eq a, Eq b) => Eq (a, b)
External instance of the constraint type Eq Integer
== (Integer, Integer)
range2 Bool -> Bool -> Bool
&& Maybe Label -> Maybe Label -> Bool
goMB Maybe Label
mbdef1 Maybe Label
mbdef2 Bool -> Bool -> Bool
&& [(Integer, Label)] -> [(Integer, Label)] -> Bool
goList (Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toList Map Integer Label
ids1) (Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toList Map Integer Label
ids2)
  where
    goMB :: Maybe Label -> Maybe Label -> Bool
goMB Maybe Label
Nothing Maybe Label
Nothing = Bool
True
    goMB (Just Label
l1) (Just Label
l2) = Label
l1 Label -> Label -> Bool
`eq` Label
l2
    goMB Maybe Label
_ Maybe Label
_ = Bool
False
    goList :: [(Integer, Label)] -> [(Integer, Label)] -> Bool
goList [] [] = Bool
True
    goList ((Integer
i1,Label
l1):[(Integer, Label)]
ls1) ((Integer
i2,Label
l2):[(Integer, Label)]
ls2) = Integer
i1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
i2 Bool -> Bool -> Bool
&& Label
l1 Label -> Label -> Bool
`eq` Label
l2 Bool -> Bool -> Bool
&& [(Integer, Label)] -> [(Integer, Label)] -> Bool
goList [(Integer, Label)]
ls1 [(Integer, Label)]
ls2
    goList [(Integer, Label)]
_ [(Integer, Label)]
_ = Bool
False

-----------------------------------------------------------------------------
-- Code generation for Switches


-- | A SwitchPlan abstractly describes how a Switch statement ought to be
-- implemented. See Note [createSwitchPlan]
data SwitchPlan
    = Unconditionally Label
    | IfEqual Integer Label SwitchPlan
    | IfLT Bool Integer SwitchPlan SwitchPlan
    | JumpTable SwitchTargets
  deriving Int -> SwitchPlan -> ShowS
[SwitchPlan] -> ShowS
SwitchPlan -> String
(Int -> SwitchPlan -> ShowS)
-> (SwitchPlan -> String)
-> ([SwitchPlan] -> ShowS)
-> Show SwitchPlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SwitchPlan] -> ShowS
$cshowList :: [SwitchPlan] -> ShowS
show :: SwitchPlan -> String
$cshow :: SwitchPlan -> String
showsPrec :: Int -> SwitchPlan -> ShowS
$cshowsPrec :: Int -> SwitchPlan -> ShowS
Instance of class: Show of the constraint type Show SwitchPlan
External instance of the constraint type Show Integer
External instance of the constraint type Show Label
External instance of the constraint type Ord Int
External instance of the constraint type Show Label
External instance of the constraint type Show Integer
External instance of the constraint type Show Bool
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show SwitchTargets
Instance of class: Show of the constraint type Show SwitchPlan
Show
--
-- Note [createSwitchPlan]
-- ~~~~~~~~~~~~~~~~~~~~~~~
--
-- A SwitchPlan describes how a Switch statement is to be broken down into
-- smaller pieces suitable for code generation.
--
-- createSwitchPlan creates such a switch plan, in these steps:
--  1. It splits the switch statement at segments of non-default values that
--     are too large. See splitAtHoles and Note [Magic Constants in GHC.Cmm.Switch]
--  2. Too small jump tables should be avoided, so we break up smaller pieces
--     in breakTooSmall.
--  3. We fill in the segments between those pieces with a jump to the default
--     label (if there is one), returning a SeparatedList in mkFlatSwitchPlan
--  4. We find and replace two less-than branches by a single equal-to-test in
--     findSingleValues
--  5. The thus collected pieces are assembled to a balanced binary tree.

{-
  Note [Two alts + default]
  ~~~~~~~~~~~~~~~~~~~~~~~~~

Discussion and a bit more info at #14644

When dealing with a switch of the form:
switch(e) {
  case 1: goto l1;
  case 3000: goto l2;
  default: goto ldef;
}

If we treat it as a sparse jump table we would generate:

if (e > 3000) //Check if value is outside of the jump table.
    goto ldef;
else {
    if (e < 3000) { //Compare to upper value
        if(e != 1) //Compare to remaining value
            goto ldef;
          else
            goto l2;
    }
    else
        goto l1;
}

Instead we special case this to :

if (e==1) goto l1;
else if (e==3000) goto l2;
else goto l3;

This means we have:
* Less comparisons for: 1,<3000
* Unchanged for 3000
* One more for >3000

This improves code in a few ways:
* One comparison less means smaller code which helps with cache.
* It exchanges a taken jump for two jumps no taken in the >range case.
  Jumps not taken are cheaper (See Agner guides) making this about as fast.
* For all other cases the first range check is removed making it faster.

The end result is that the change is not measurably slower for the case
>3000 and faster for the other cases.

This makes running this kind of match in an inner loop cheaper by 10-20%
depending on the data.
In nofib this improves wheel-sieve1 by 4-9% depending on problem
size.

We could also add a second conditional jump after the comparison to
keep the range check like this:
    cmp 3000, rArgument
    jg <default>
    je <branch 2>
While this is fairly cheap it made no big difference for the >3000 case
and slowed down all other cases making it not worthwhile.
-}


-- | Does the target support switch out of the box? Then leave this to the
-- target!
targetSupportsSwitch :: HscTarget -> Bool
targetSupportsSwitch :: HscTarget -> Bool
targetSupportsSwitch HscTarget
HscC = Bool
True
targetSupportsSwitch HscTarget
HscLlvm = Bool
True
targetSupportsSwitch HscTarget
_ = Bool
False

-- | This function creates a SwitchPlan from a SwitchTargets value, breaking it
-- down into smaller pieces suitable for code generation.
createSwitchPlan :: SwitchTargets -> SwitchPlan
-- Lets do the common case of a singleton map quickly and efficiently (#10677)
createSwitchPlan :: SwitchTargets -> SwitchPlan
createSwitchPlan (SwitchTargets Bool
_signed (Integer, Integer)
_range (Just Label
defLabel) Map Integer Label
m)
    | [(Integer
x, Label
l)] <- Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toList Map Integer Label
m
    = Integer -> Label -> SwitchPlan -> SwitchPlan
IfEqual Integer
x Label
l (Label -> SwitchPlan
Unconditionally Label
defLabel)
-- And another common case, matching "booleans"
createSwitchPlan (SwitchTargets Bool
_signed (Integer
lo,Integer
hi) Maybe Label
Nothing Map Integer Label
m)
    | [(Integer
x1, Label
l1), (Integer
_x2,Label
l2)] <- Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Integer Label
m
    --Checking If |range| = 2 is enough if we have two unique literals
    , Integer
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
- Integer
lo Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
1
    = Integer -> Label -> SwitchPlan -> SwitchPlan
IfEqual Integer
x1 Label
l1 (Label -> SwitchPlan
Unconditionally Label
l2)
-- See Note [Two alts + default]
createSwitchPlan (SwitchTargets Bool
_signed (Integer, Integer)
_range (Just Label
defLabel) Map Integer Label
m)
    | [(Integer
x1, Label
l1), (Integer
x2,Label
l2)] <- Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map Integer Label
m
    = Integer -> Label -> SwitchPlan -> SwitchPlan
IfEqual Integer
x1 Label
l1 (Integer -> Label -> SwitchPlan -> SwitchPlan
IfEqual Integer
x2 Label
l2 (Label -> SwitchPlan
Unconditionally Label
defLabel))
createSwitchPlan (SwitchTargets Bool
signed (Integer, Integer)
range Maybe Label
mbdef Map Integer Label
m) =
    -- pprTrace "createSwitchPlan" (text (show ids) $$ text (show (range,m)) $$ text (show pieces) $$ text (show flatPlan) $$ text (show plan)) $
    SwitchPlan
plan
  where
    pieces :: [Map Integer Label]
pieces = (Map Integer Label -> [Map Integer Label])
-> [Map Integer Label] -> [Map Integer Label]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap Map Integer Label -> [Map Integer Label]
forall a. Map Integer a -> [Map Integer a]
breakTooSmall ([Map Integer Label] -> [Map Integer Label])
-> [Map Integer Label] -> [Map Integer Label]
forall a b. (a -> b) -> a -> b
$ Integer -> Map Integer Label -> [Map Integer Label]
forall a. Integer -> Map Integer a -> [Map Integer a]
splitAtHoles Integer
maxJumpTableHole Map Integer Label
m
    flatPlan :: FlatSwitchPlan
flatPlan = FlatSwitchPlan -> FlatSwitchPlan
findSingleValues (FlatSwitchPlan -> FlatSwitchPlan)
-> FlatSwitchPlan -> FlatSwitchPlan
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Label
-> (Integer, Integer)
-> [Map Integer Label]
-> FlatSwitchPlan
mkFlatSwitchPlan Bool
signed Maybe Label
mbdef (Integer, Integer)
range [Map Integer Label]
pieces
    plan :: SwitchPlan
plan = Bool -> FlatSwitchPlan -> SwitchPlan
buildTree Bool
signed (FlatSwitchPlan -> SwitchPlan) -> FlatSwitchPlan -> SwitchPlan
forall a b. (a -> b) -> a -> b
$ FlatSwitchPlan
flatPlan


---
--- Step 1: Splitting at large holes
---
splitAtHoles :: Integer -> M.Map Integer a -> [M.Map Integer a]
splitAtHoles :: Integer -> Map Integer a -> [Map Integer a]
splitAtHoles Integer
_        Map Integer a
m | Map Integer a -> Bool
forall k a. Map k a -> Bool
M.null Map Integer a
m = []
splitAtHoles Integer
holeSize Map Integer a
m = ((Integer, Integer) -> Map Integer a)
-> [(Integer, Integer)] -> [Map Integer a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Integer, Integer)
range -> (Integer, Integer) -> Map Integer a -> Map Integer a
forall b. (Integer, Integer) -> Map Integer b -> Map Integer b
restrictMap (Integer, Integer)
range Map Integer a
m) [(Integer, Integer)]
nonHoles
  where
    holes :: [(Integer, Integer)]
holes = ((Integer, Integer) -> Bool)
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Integer
l,Integer
h) -> Integer
h Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
- Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
> Integer
holeSize) ([(Integer, Integer)] -> [(Integer, Integer)])
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer] -> [(Integer, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map Integer a -> [Integer]
forall k a. Map k a -> [k]
M.keys Map Integer a
m) ([Integer] -> [Integer]
forall a. [a] -> [a]
tail (Map Integer a -> [Integer]
forall k a. Map k a -> [k]
M.keys Map Integer a
m))
    nonHoles :: [(Integer, Integer)]
nonHoles = Integer -> [(Integer, Integer)] -> Integer -> [(Integer, Integer)]
forall a. a -> [(a, a)] -> a -> [(a, a)]
reassocTuples Integer
lo [(Integer, Integer)]
holes Integer
hi

    (Integer
lo,a
_) = Map Integer a -> (Integer, a)
forall k a. Map k a -> (k, a)
M.findMin Map Integer a
m
    (Integer
hi,a
_) = Map Integer a -> (Integer, a)
forall k a. Map k a -> (k, a)
M.findMax Map Integer a
m

---
--- Step 2: Avoid small jump tables
---
-- We do not want jump tables below a certain size. This breaks them up
-- (into singleton maps, for now).
breakTooSmall :: M.Map Integer a -> [M.Map Integer a]
breakTooSmall :: Map Integer a -> [Map Integer a]
breakTooSmall Map Integer a
m
  | Map Integer a -> Int
forall k a. Map k a -> Int
M.size Map Integer a
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
minJumpTableSize = [Map Integer a
m]
  | Bool
otherwise                   = [Integer -> a -> Map Integer a
forall k a. k -> a -> Map k a
M.singleton Integer
k a
v | (Integer
k,a
v) <- Map Integer a -> [(Integer, a)]
forall k a. Map k a -> [(k, a)]
M.toList Map Integer a
m]

---
---  Step 3: Fill in the blanks
---

-- | A FlatSwitchPlan is a list of SwitchPlans, with an integer inbetween every
-- two entries, dividing the range.
-- So if we have (abusing list syntax) [plan1,n,plan2], then we use plan1 if
-- the expression is < n, and plan2 otherwise.

type FlatSwitchPlan = SeparatedList Integer SwitchPlan

mkFlatSwitchPlan :: Bool -> Maybe Label -> (Integer, Integer) -> [M.Map Integer Label] -> FlatSwitchPlan

-- If we have no default (i.e. undefined where there is no entry), we can
-- branch at the minimum of each map
mkFlatSwitchPlan :: Bool
-> Maybe Label
-> (Integer, Integer)
-> [Map Integer Label]
-> FlatSwitchPlan
mkFlatSwitchPlan Bool
_ Maybe Label
Nothing (Integer, Integer)
_ [] = String -> SDoc -> FlatSwitchPlan
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkFlatSwitchPlan with nothing left to do" SDoc
empty
mkFlatSwitchPlan Bool
signed  Maybe Label
Nothing (Integer, Integer)
_ (Map Integer Label
m:[Map Integer Label]
ms)
  = (Bool -> Maybe Label -> Map Integer Label -> SwitchPlan
mkLeafPlan Bool
signed Maybe Label
forall a. Maybe a
Nothing Map Integer Label
m , [ ((Integer, Label) -> Integer
forall a b. (a, b) -> a
fst (Map Integer Label -> (Integer, Label)
forall k a. Map k a -> (k, a)
M.findMin Map Integer Label
m'), Bool -> Maybe Label -> Map Integer Label -> SwitchPlan
mkLeafPlan Bool
signed Maybe Label
forall a. Maybe a
Nothing Map Integer Label
m') | Map Integer Label
m' <- [Map Integer Label]
ms ])

-- If we have a default, we have to interleave segments that jump
-- to the default between the maps
mkFlatSwitchPlan Bool
signed (Just Label
l) (Integer, Integer)
r [Map Integer Label]
ms = let ((Integer
_,SwitchPlan
p1):[(Integer, SwitchPlan)]
ps) = (Integer, Integer)
-> [Map Integer Label] -> [(Integer, SwitchPlan)]
go (Integer, Integer)
r [Map Integer Label]
ms in (SwitchPlan
p1, [(Integer, SwitchPlan)]
ps)
  where
    go :: (Integer, Integer)
-> [Map Integer Label] -> [(Integer, SwitchPlan)]
go (Integer
lo,Integer
hi) []
        | Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
> Integer
hi = []
        | Bool
otherwise = [(Integer
lo, Label -> SwitchPlan
Unconditionally Label
l)]
    go (Integer
lo,Integer
hi) (Map Integer Label
m:[Map Integer Label]
ms)
        | Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
< Integer
min
        = (Integer
lo, Label -> SwitchPlan
Unconditionally Label
l) (Integer, SwitchPlan)
-> [(Integer, SwitchPlan)] -> [(Integer, SwitchPlan)]
forall a. a -> [a] -> [a]
: (Integer, Integer)
-> [Map Integer Label] -> [(Integer, SwitchPlan)]
go (Integer
min,Integer
hi) (Map Integer Label
mMap Integer Label -> [Map Integer Label] -> [Map Integer Label]
forall a. a -> [a] -> [a]
:[Map Integer Label]
ms)
        | Integer
lo Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
min
        = (Integer
lo, Bool -> Maybe Label -> Map Integer Label -> SwitchPlan
mkLeafPlan Bool
signed (Label -> Maybe Label
forall a. a -> Maybe a
Just Label
l) Map Integer Label
m) (Integer, SwitchPlan)
-> [(Integer, SwitchPlan)] -> [(Integer, SwitchPlan)]
forall a. a -> [a] -> [a]
: (Integer, Integer)
-> [Map Integer Label] -> [(Integer, SwitchPlan)]
go (Integer
maxInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
1,Integer
hi) [Map Integer Label]
ms
        | Bool
otherwise
        = String -> SDoc -> [(Integer, SwitchPlan)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkFlatSwitchPlan" (Integer -> SDoc
integer Integer
lo SDoc -> SDoc -> SDoc
<+> Integer -> SDoc
integer Integer
min)
      where
        min :: Integer
min = (Integer, Label) -> Integer
forall a b. (a, b) -> a
fst (Map Integer Label -> (Integer, Label)
forall k a. Map k a -> (k, a)
M.findMin Map Integer Label
m)
        max :: Integer
max = (Integer, Label) -> Integer
forall a b. (a, b) -> a
fst (Map Integer Label -> (Integer, Label)
forall k a. Map k a -> (k, a)
M.findMax Map Integer Label
m)


mkLeafPlan :: Bool -> Maybe Label -> M.Map Integer Label -> SwitchPlan
mkLeafPlan :: Bool -> Maybe Label -> Map Integer Label -> SwitchPlan
mkLeafPlan Bool
signed Maybe Label
mbdef Map Integer Label
m
    | [(Integer
_,Label
l)] <- Map Integer Label -> [(Integer, Label)]
forall k a. Map k a -> [(k, a)]
M.toList Map Integer Label
m -- singleton map
    = Label -> SwitchPlan
Unconditionally Label
l
    | Bool
otherwise
    = SwitchTargets -> SwitchPlan
JumpTable (SwitchTargets -> SwitchPlan) -> SwitchTargets -> SwitchPlan
forall a b. (a -> b) -> a -> b
$ Bool
-> (Integer, Integer)
-> Maybe Label
-> Map Integer Label
-> SwitchTargets
mkSwitchTargets Bool
signed (Integer
min,Integer
max) Maybe Label
mbdef Map Integer Label
m
  where
    min :: Integer
min = (Integer, Label) -> Integer
forall a b. (a, b) -> a
fst (Map Integer Label -> (Integer, Label)
forall k a. Map k a -> (k, a)
M.findMin Map Integer Label
m)
    max :: Integer
max = (Integer, Label) -> Integer
forall a b. (a, b) -> a
fst (Map Integer Label -> (Integer, Label)
forall k a. Map k a -> (k, a)
M.findMax Map Integer Label
m)

---
---  Step 4: Reduce the number of branches using ==
---

-- A sequence of three unconditional jumps, with the outer two pointing to the
-- same value and the bounds off by exactly one can be improved
findSingleValues :: FlatSwitchPlan -> FlatSwitchPlan
findSingleValues :: FlatSwitchPlan -> FlatSwitchPlan
findSingleValues (Unconditionally Label
l, (Integer
i, Unconditionally Label
l2) : (Integer
i', Unconditionally Label
l3) : [(Integer, SwitchPlan)]
xs)
  | Label
l Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Label
== Label
l3 Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+ Integer
1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Integer
== Integer
i'
  = FlatSwitchPlan -> FlatSwitchPlan
findSingleValues (Integer -> Label -> SwitchPlan -> SwitchPlan
IfEqual Integer
i Label
l2 (Label -> SwitchPlan
Unconditionally Label
l), [(Integer, SwitchPlan)]
xs)
findSingleValues (SwitchPlan
p, (Integer
i,SwitchPlan
p'):[(Integer, SwitchPlan)]
xs)
  = (SwitchPlan
p,Integer
i) (SwitchPlan, Integer) -> FlatSwitchPlan -> FlatSwitchPlan
forall a b. (a, b) -> SeparatedList b a -> SeparatedList b a
`consSL` FlatSwitchPlan -> FlatSwitchPlan
findSingleValues (SwitchPlan
p', [(Integer, SwitchPlan)]
xs)
findSingleValues (SwitchPlan
p, [])
  = (SwitchPlan
p, [])

---
---  Step 5: Actually build the tree
---

-- Build a balanced tree from a separated list
buildTree :: Bool -> FlatSwitchPlan -> SwitchPlan
buildTree :: Bool -> FlatSwitchPlan -> SwitchPlan
buildTree Bool
_ (SwitchPlan
p,[]) = SwitchPlan
p
buildTree Bool
signed FlatSwitchPlan
sl = Bool -> Integer -> SwitchPlan -> SwitchPlan -> SwitchPlan
IfLT Bool
signed Integer
m (Bool -> FlatSwitchPlan -> SwitchPlan
buildTree Bool
signed FlatSwitchPlan
sl1) (Bool -> FlatSwitchPlan -> SwitchPlan
buildTree Bool
signed FlatSwitchPlan
sl2)
  where
    (FlatSwitchPlan
sl1, Integer
m, FlatSwitchPlan
sl2) = FlatSwitchPlan -> (FlatSwitchPlan, Integer, FlatSwitchPlan)
forall b a.
SeparatedList b a -> (SeparatedList b a, b, SeparatedList b a)
divideSL FlatSwitchPlan
sl



--
-- Utility data type: Non-empty lists with extra markers in between each
-- element:
--

type SeparatedList b a = (a, [(b,a)])

consSL :: (a, b) -> SeparatedList b a -> SeparatedList b a
consSL :: (a, b) -> SeparatedList b a -> SeparatedList b a
consSL (a
a, b
b) (a
a', [(b, a)]
xs) = (a
a, (b
b,a
a')(b, a) -> [(b, a)] -> [(b, a)]
forall a. a -> [a] -> [a]
:[(b, a)]
xs)

divideSL :: SeparatedList b a -> (SeparatedList b a, b, SeparatedList b a)
divideSL :: SeparatedList b a -> (SeparatedList b a, b, SeparatedList b a)
divideSL (a
_,[]) = String -> (SeparatedList b a, b, SeparatedList b a)
forall a. HasCallStack => String -> a
error String
"divideSL: Singleton SeparatedList"
divideSL (a
p,[(b, a)]
xs) = ((a
p, [(b, a)]
xs1), b
m, (a
p', [(b, a)]
xs2))
  where
    ([(b, a)]
xs1, (b
m,a
p'):[(b, a)]
xs2) = Int -> [(b, a)] -> ([(b, a)], [(b, a)])
forall a. Int -> [a] -> ([a], [a])
splitAt ([(b, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
External instance of the constraint type Foldable []
length [(b, a)]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
External instance of the constraint type Integral Int
`div` Int
2) [(b, a)]
xs

--
-- Other Utilities
--

restrictMap :: (Integer,Integer) -> M.Map Integer b -> M.Map Integer b
restrictMap :: (Integer, Integer) -> Map Integer b -> Map Integer b
restrictMap (Integer
lo,Integer
hi) Map Integer b
m = Map Integer b
mid
  where (Map Integer b
_,   Map Integer b
mid_hi) = Integer -> Map Integer b -> (Map Integer b, Map Integer b)
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
External instance of the constraint type Ord Integer
M.split (Integer
loInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
-Integer
1) Map Integer b
m
        (Map Integer b
mid, Map Integer b
_) =      Integer -> Map Integer b -> (Map Integer b, Map Integer b)
forall k a. Ord k => k -> Map k a -> (Map k a, Map k a)
External instance of the constraint type Ord Integer
M.split (Integer
hiInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
External instance of the constraint type Num Integer
+Integer
1) Map Integer b
mid_hi

-- for example: reassocTuples a [(b,c),(d,e)] f == [(a,b),(c,d),(e,f)]
reassocTuples :: a -> [(a,a)] -> a -> [(a,a)]
reassocTuples :: a -> [(a, a)] -> a -> [(a, a)]
reassocTuples a
initial [] a
last
    = [(a
initial,a
last)]
reassocTuples a
initial ((a
a,a
b):[(a, a)]
tuples) a
last
    = (a
initial,a
a) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: a -> [(a, a)] -> a -> [(a, a)]
forall a. a -> [(a, a)] -> a -> [(a, a)]
reassocTuples a
b [(a, a)]
tuples a
last

-- Note [GHC.Cmm.Switch vs. GHC.Cmm.Switch.Implement]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- I (Joachim) separated the two somewhat closely related modules
--
--  - GHC.Cmm.Switch, which provides the CmmSwitchTargets type and contains the strategy
--    for implementing a Cmm switch (createSwitchPlan), and
--  - GHC.Cmm.Switch.Implement, which contains the actual Cmm graph modification,
--
-- for these reasons:
--
--  * GHC.Cmm.Switch is very low in the dependency tree, i.e. does not depend on any
--    GHC specific modules at all (with the exception of Output and
--    GHC.Cmm.Dataflow (Literal)).
--  * GHC.Cmm.Switch.Implement is the Cmm transformation and hence very high in
--    the dependency tree.
--  * GHC.Cmm.Switch provides the CmmSwitchTargets data type, which is abstract, but
--    used in GHC.Cmm.Node.
--  * Because GHC.Cmm.Switch is low in the dependency tree, the separation allows
--    for more parallelism when building GHC.
--  * The interaction between the modules is very explicit and easy to
--    understand, due to the small and simple interface.