{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Cmm.Switch (
SwitchTargets,
mkSwitchTargets,
switchTargetsCases, switchTargetsDefault, switchTargetsRange, switchTargetsSigned,
mapSwitchTargets, mapSwitchTargetsA, switchTargetsToTable, switchTargetsFallThrough,
switchTargetsToList, eqSwitchTargetWith,
SwitchPlan(..),
backendHasNativeSwitch,
createSwitchPlan,
) where
import GHC.Prelude hiding (head)
import GHC.Utils.Outputable
import GHC.Driver.Backend
import GHC.Utils.Panic
import GHC.Cmm.Dataflow.Label (Label)
import Data.Maybe
import Data.List.NonEmpty (NonEmpty (..), groupWith, head)
import qualified Data.Map as M
maxJumpTableHole :: Integer
maxJumpTableHole :: Integer
maxJumpTableHole = Integer
7
minJumpTableSize :: Int
minJumpTableSize :: Int
minJumpTableSize = Int
5
minJumpTableOffset :: Integer
minJumpTableOffset :: Integer
minJumpTableOffset = Integer
2
data SwitchTargets =
SwitchTargets
Bool
(Integer, Integer)
(Maybe Label)
(M.Map Integer Label)
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
$cshowsPrec :: Int -> SwitchTargets -> ShowS
showsPrec :: Int -> SwitchTargets -> ShowS
$cshow :: SwitchTargets -> String
show :: SwitchTargets -> String
$cshowList :: [SwitchTargets] -> ShowS
showList :: [SwitchTargets] -> ShowS
Show, SwitchTargets -> SwitchTargets -> Bool
(SwitchTargets -> SwitchTargets -> Bool)
-> (SwitchTargets -> SwitchTargets -> Bool) -> Eq SwitchTargets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwitchTargets -> SwitchTargets -> Bool
== :: SwitchTargets -> SwitchTargets -> Bool
$c/= :: SwitchTargets -> SwitchTargets -> Bool
/= :: SwitchTargets -> SwitchTargets -> Bool
Eq)
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
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)
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
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
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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Map Integer a -> Map Integer b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Label -> Label
f Map Integer Label
branches)
mapSwitchTargetsA :: Applicative m => (Label -> m Label) -> SwitchTargets -> m SwitchTargets
mapSwitchTargetsA :: forall (m :: * -> *).
Applicative m =>
(Label -> m Label) -> SwitchTargets -> m SwitchTargets
mapSwitchTargetsA Label -> m 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 (Maybe Label -> Map Integer Label -> SwitchTargets)
-> m (Maybe Label) -> m (Map Integer Label -> SwitchTargets)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Label -> m Label) -> Maybe Label -> m (Maybe Label)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Label -> m Label
f Maybe Label
mbdef m (Map Integer Label -> SwitchTargets)
-> m (Map Integer Label) -> m SwitchTargets
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Label -> m Label) -> Map Integer Label -> m (Map Integer Label)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Integer a -> f (Map Integer b)
traverse Label -> m Label
f Map Integer Label
branches
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
switchTargetsDefault :: SwitchTargets -> Maybe Label
switchTargetsDefault :: SwitchTargets -> Maybe Label
switchTargetsDefault (SwitchTargets Bool
_ (Integer, Integer)
_ Maybe Label
mbdef Map Integer Label
_) = Maybe Label
mbdef
switchTargetsRange :: SwitchTargets -> (Integer, Integer)
switchTargetsRange :: SwitchTargets -> (Integer, Integer)
switchTargetsRange (SwitchTargets Bool
_ (Integer, Integer)
range Maybe Label
_ Map Integer Label
_) = (Integer, Integer)
range
switchTargetsSigned :: SwitchTargets -> Bool
switchTargetsSigned :: SwitchTargets -> Bool
switchTargetsSigned (SwitchTargets Bool
signed (Integer, Integer)
_ Maybe Label
_ Map Integer Label
_) = Bool
signed
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
| Bool
otherwise = Integer
lo
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
switchTargetsFallThrough :: SwitchTargets -> ([(NonEmpty Integer, Label)], Maybe Label)
switchTargetsFallThrough :: SwitchTargets -> ([(NonEmpty Integer, Label)], Maybe Label)
switchTargetsFallThrough (SwitchTargets Bool
_ (Integer, Integer)
_ Maybe Label
mbdef Map Integer Label
branches) = ([(NonEmpty Integer, Label)]
groups, Maybe Label
mbdef)
where
groups :: [(NonEmpty Integer, Label)]
groups = (NonEmpty (Integer, Label) -> (NonEmpty Integer, Label))
-> [NonEmpty (Integer, Label)] -> [(NonEmpty Integer, Label)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonEmpty (Integer, Label)
xs -> (((Integer, Label) -> Integer)
-> NonEmpty (Integer, Label) -> NonEmpty Integer
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Label) -> Integer
forall a b. (a, b) -> a
fst NonEmpty (Integer, Label)
xs, (Integer, Label) -> Label
forall a b. (a, b) -> b
snd (NonEmpty (Integer, Label) -> (Integer, Label)
forall a. NonEmpty a -> a
head NonEmpty (Integer, Label)
xs))) ([NonEmpty (Integer, Label)] -> [(NonEmpty Integer, Label)])
-> [NonEmpty (Integer, Label)] -> [(NonEmpty Integer, Label)]
forall a b. (a -> b) -> a -> b
$
((Integer, Label) -> Label)
-> [(Integer, Label)] -> [NonEmpty (Integer, Label)]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
groupWith (Integer, Label) -> Label
forall a b. (a, b) -> b
snd ([(Integer, Label)] -> [NonEmpty (Integer, Label)])
-> [(Integer, Label)] -> [NonEmpty (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
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
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
$cshowsPrec :: Int -> SwitchPlan -> ShowS
showsPrec :: Int -> SwitchPlan -> ShowS
$cshow :: SwitchPlan -> String
show :: SwitchPlan -> String
$cshowList :: [SwitchPlan] -> ShowS
showList :: [SwitchPlan] -> ShowS
Show
createSwitchPlan :: SwitchTargets -> SwitchPlan
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)
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
, 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)
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) =
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
splitAtHoles :: Integer -> M.Map Integer a -> [M.Map Integer a]
splitAtHoles :: forall a. 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. HasCallStack => [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
breakTooSmall :: M.Map Integer a -> [M.Map Integer a]
breakTooSmall :: forall a. 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]
type FlatSwitchPlan = SeparatedList Integer SwitchPlan
mkFlatSwitchPlan :: Bool -> Maybe Label -> (Integer, Integer) -> [M.Map Integer Label] -> FlatSwitchPlan
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
forall doc. IsOutput doc => doc
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 ])
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
forall doc. IsLine doc => Integer -> doc
integer Integer
lo SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
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
= 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)
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, [])
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
type SeparatedList b a = (a, [(b,a)])
consSL :: (a, b) -> SeparatedList b a -> SeparatedList b a
consSL :: forall a b. (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 :: forall b a.
SeparatedList b a -> (SeparatedList b a, b, SeparatedList b a)
divideSL (a
_,[]) = String -> ((a, [(b, a)]), b, (a, [(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 a. [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
restrictMap :: (Integer,Integer) -> M.Map Integer b -> M.Map Integer b
restrictMap :: forall b. (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
reassocTuples :: a -> [(a,a)] -> a -> [(a,a)]
reassocTuples :: forall a. 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