{-# LANGUAGE GADTs #-}
module CmmSwitch (
     SwitchTargets,
     mkSwitchTargets,
     switchTargetsCases, switchTargetsDefault, switchTargetsRange, switchTargetsSigned,
     mapSwitchTargets, switchTargetsToTable, switchTargetsFallThrough,
     switchTargetsToList, eqSwitchTargetWith,

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

import GhcPrelude

import Outputable
import DynFlags
import Hoopl.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.hs.
--    At this stage, they are unsuitable for code generation.
--  * A dedicated Cmm transformation (CmmImplementSwitchPlans) 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, CmmImplementSwitchPlans 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 [CmmSwitch vs. CmmImplementSwitchPlans] why the two module are
-- separated.

-----------------------------------------------------------------------------
-- Note [Magic Constants in CmmSwitch]
--
-- 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
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
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
/= 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
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
/= Integer
hiInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
loInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+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
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
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
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
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
>= Integer
0 Bool -> Bool -> Bool
&& Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 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 occuring 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
(==) (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 "CmmCommonBlockElim"
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
== Bool
signed2 Bool -> Bool -> Bool
&& (Integer, Integer)
range1 (Integer, Integer) -> (Integer, Integer) -> Bool
forall a. Eq a => a -> a -> Bool
== (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
== 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
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 CmmSwitch]
--  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 quicky 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
- Integer
lo Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 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]
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
- Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 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
> 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
> 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
< 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
== 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
+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
== Label
l3 Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 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
length [(b, a)]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`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)
M.split (Integer
loInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-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)
M.split (Integer
hiInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+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 [CmmSwitch vs. CmmImplementSwitchPlans]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- I (Joachim) separated the two somewhat closely related modules
--
--  - CmmSwitch, which provides the CmmSwitchTargets type and contains the strategy
--    for implementing a Cmm switch (createSwitchPlan), and
--  - CmmImplementSwitchPlans, which contains the actuall Cmm graph modification,
--
-- for these reasons:
--
--  * CmmSwitch 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 Hoople
--    (Literal)). CmmImplementSwitchPlans is the Cmm transformation and hence very
--    high in the dependency tree.
--  * CmmSwitch provides the CmmSwitchTargets data type, which is abstract, but
--    used in CmmNodes.
--  * Because CmmSwitch 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.