{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}

-- | Range analysis
--
-- See Note [Value range analysis]
module GHC.Core.Opt.Range
  ( Comparison(..)
  , Range(..)
  , noRange
  , valueRange
  , rangeIntersect
  , rangeCastFrom
  , inRange
  , rangeSize
  , rangeCmp
  , rangeLe
  , rangeGe
  , rangeLt
  , rangeGt
  , rangeOf
  , rangeWord
  , rangeWord8
  , rangeWord16
  , rangeWord32
  , rangeWord64
  , rangeChar
  , rangeInt
  , rangeInt8
  , rangeInt16
  , rangeInt32
  , rangeInt64
  )
where

import GHC.Prelude
import GHC.Platform
import GHC.Core
import GHC.Builtin.PrimOps ( PrimOp(..) )
import GHC.Builtin.PrimOps.Ids (primOpId)
import GHC.Types.Literal
import GHC.Types.Id
#if defined(DEBUG)
import GHC.Utils.Outputable
import GHC.Utils.Panic
#endif

import Data.Word
import Data.Int
import Data.Char (ord)
import Data.Maybe

{-
Note [Value range analysis]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
To perform some constant-folding optimisations, it is sometimes enough to know
the range (interval) of what an expression will evaluate to. For example,
consider the following expression:

  word8ToWord x < 256

Even without knowing the value of 'x', we know that:

  - x is in range [0,255] because it is of type Word8
  - `word8ToWord x` is in range [0,255] despite being of type Word
  - `word8ToWord x < 256` is always `True`

When a comparison primop is applied to two expressions (e.g. `ltWord# e1 e2`),
we infer the ranges of `e1` and `e2` and use them to try to statically compute
the result of the comparison (see `rangeCmp` function in this module).

Value range analysis consists in inferring the range of a CoreExpr.
    valueRange :: Platform -> CoreExpr -> Range
is the workhorse function doing this analysis in this module. It traverses a
CoreExpr recursively to infer a range as precise as possible. It takes into
account:

  - literals: a literal 'n' implies a range [n,n]
  - narrowing primops (e.g. Narrow8IntOp)
  - conversion primops (e.g. WordToIntOp)
  - addition and subtraction primops (e.g. Word32AddOp)
  - logical AND primops
  - variable unfoldings: for example, consider:
        case word8ToWord# x of y { ... case ltWord# y 256## { ... }}
    the value range analysis is triggered in a rewrite-rule for ltWord# on
    both `y` and `256##`. `y` is a variable so the analysis looks into its
    unfolding (here `word8ToWord# x`) to infer its range. It's obviously only
    possible when the variable has an unfolding. This unfolding, however, isn't
    required to be expandable as we're not expanding/inlining the unfolding,
    just computing its value range.

VRA1: Filtering unreachable alternatives based on range analysis
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the following example:

  case word8ToWord# x of
    123456# -> ...
    ...

By applying value range analysis to the scrutinee, GHC infers that the 123456#
alternative is unreachable because it's out of the range [0,255] of the
scrutinee, hence it will never match.

This filtering is done in GHC.Core.Opt.ConstantFold.caseRules2. See also T25718b


Limitation 1: no disjoint ranges
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The current implementation doesn't support disjoint ranges hence it can't
precisely track some ranges. In these cases it falls back to a wider range.
For example: range analysis for `word8ToInt8 x` where x is in [100,130] would
need a disjoint range union to be represented as [100,127] U [-128,-126] because
of the overflow (130 > 127). See `rangeCastFrom` function in this module for the
implementation.

Similarly, additions and subtractions may overflow/underflow. In these cases, we
would also need disjoint ranges to represent the resulting range. For example,
`x+1` where (x :: Word8) and x is in [100,255] would require a disjoint range
union: [0,0] U [101,255].
We use `rangeCastFrom` to handle these cases too: e.g. `x+1` (as described
above) is first computed to be in range [101,256] (ignoring the Word8 type), but
this range isn't in Word8's range [0,255], so conservatively we assume a range
[0,255] for `x+1` expression

Limitation 2: limited top-down range information in alternatives
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The value range analysis for a variable currently consists in applying the
analysis to the variable's unfolding (when it is available). This approach
doesn't return the most precise range possible in some cases. For example
consider:

  case x ># 0# of
    1# -> {- Here we should know that x's range is > 0 -}
    0# -> {- ... and here <= 0 -}

In both alternatives `x`'s unfolding (if any) is the same, yet we should be able
to infer a different range for `x` as a consequence of the pattern matching on
the comparison operator application.

Possible future work: we could imagine extending the unfolding information to
include range information. Then a top-down pass could compute and store more
precise range information in cases like this one. Implementing this should
change the output of the T25718a test.

-}

data Comparison = Gt | Ge | Lt | Le deriving (Int -> Comparison -> ShowS
[Comparison] -> ShowS
Comparison -> String
(Int -> Comparison -> ShowS)
-> (Comparison -> String)
-> ([Comparison] -> ShowS)
-> Show Comparison
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comparison -> ShowS
showsPrec :: Int -> Comparison -> ShowS
$cshow :: Comparison -> String
show :: Comparison -> String
$cshowList :: [Comparison] -> ShowS
showList :: [Comparison] -> ShowS
Show)


-- | A range (minBound,maxBound)
--
-- Bounds may not be known.
data Range
  = MkRange {-# UNPACK #-} !(Maybe Integer) -- ^ Lower bound: Nothing means unbounded below
            {-# UNPACK #-} !(Maybe Integer) -- ^ Upper bound: Nothing means unbounded above
  deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq,Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> String
show :: Range -> String
$cshowList :: [Range] -> ShowS
showList :: [Range] -> ShowS
Show)

pattern Range :: Maybe Integer -> Maybe Integer -> Range
pattern $mRange :: forall {r}.
Range -> (Maybe Integer -> Maybe Integer -> r) -> ((# #) -> r) -> r
$bRange :: Maybe Integer -> Maybe Integer -> Range
Range x y <- MkRange x y
  where
    Range Maybe Integer
x Maybe Integer
y = Maybe Integer -> Maybe Integer -> Range
mkRange Maybe Integer
x Maybe Integer
y

{-# COMPLETE Range #-}

mkRange :: Maybe Integer -> Maybe Integer -> Range
mkRange :: Maybe Integer -> Maybe Integer -> Range
mkRange = \cases
#if defined(DEBUG)
  -- check that the bounds of the range are well ordered.
  (Just x) (Just y) | x > y -> pprPanic "Invalid range" (ppr (x,y))
#endif
  Maybe Integer
x Maybe Integer
y -> Maybe Integer -> Maybe Integer -> Range
MkRange Maybe Integer
x Maybe Integer
y


-- | Compute the intersection of two overlapping ranges.
--
-- If the two ranges don't overlap, result is undefined.
rangeIntersect :: Range -> Range -> Range
rangeIntersect :: Range -> Range -> Range
rangeIntersect (Range Maybe Integer
mi1 Maybe Integer
ma1) (Range Maybe Integer
mi2 Maybe Integer
ma2) = Maybe Integer -> Maybe Integer -> Range
Range Maybe Integer
mi Maybe Integer
ma
  where
    merge :: (t -> t -> t) -> Maybe t -> Maybe t -> Maybe t
merge t -> t -> t
op = \cases
      Maybe t
Nothing  Maybe t
Nothing  -> Maybe t
forall a. Maybe a
Nothing
      Maybe t
Nothing  Maybe t
v        -> Maybe t
v
      Maybe t
v        Maybe t
Nothing  -> Maybe t
v
      (Just t
a) (Just t
b) -> t -> Maybe t
forall a. a -> Maybe a
Just (t -> t -> t
op t
a t
b)
    mi :: Maybe Integer
mi = (Integer -> Integer -> Integer)
-> Maybe Integer -> Maybe Integer -> Maybe Integer
forall {t}. (t -> t -> t) -> Maybe t -> Maybe t -> Maybe t
merge Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Maybe Integer
mi1 Maybe Integer
mi2
    ma :: Maybe Integer
ma = (Integer -> Integer -> Integer)
-> Maybe Integer -> Maybe Integer -> Maybe Integer
forall {t}. (t -> t -> t) -> Maybe t -> Maybe t -> Maybe t
merge Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Maybe Integer
ma1 Maybe Integer
ma2

-- | Used for casts that share representation over a sub-range (e.g. [0,127] for
-- Word8# ([0,255]) and Int8# ([-128,127]))
--
-- If from_range isn't fully included into to_range, then we return to_range.
-- That's because for now we don't have a way to track disjoined ranges.
--    E.g. if we wanted to cast [-1,10] (Int8) into [0,255] (Word8), we would
--    need to represent a range union: [0,10] U [255,255] (Word8)
--
-- We also use this function to ensure that the result of an arithmetic
-- operation on ranges didn't overflow/underflow.
rangeCastFrom :: Range -> Range -> Range
rangeCastFrom :: Range -> Range -> Range
rangeCastFrom Range
to_range Range
from_range = case Range
from_range of
  Range (Just Integer
mi) (Just Integer
ma)
    | Integer
mi Integer -> Range -> Bool
`inRange` Range
to_range
    , Integer
ma Integer -> Range -> Bool
`inRange` Range
to_range
    -> Range
from_range
  Range
_ -> Range
to_range

inRange :: Integer -> Range -> Bool
inRange :: Integer -> Range -> Bool
inRange Integer
x = \case
  Range Maybe Integer
Nothing   Maybe Integer
Nothing   -> Bool
True
  Range (Just Integer
mi) Maybe Integer
Nothing   -> Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
mi
  Range (Just Integer
mi) (Just Integer
ma) -> Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
mi Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
ma
  Range Maybe Integer
Nothing   (Just Integer
ma) -> Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
ma

rangeSize :: Range -> Maybe Integer
rangeSize :: Range -> Maybe Integer
rangeSize = \case
  Range (Just Integer
mi) (Just Integer
ma) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
maInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
miInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
  Range
_                         -> Maybe Integer
forall a. Maybe a
Nothing

-- | Addition of two ranges
rangeAdd :: Range -> Range -> Range
rangeAdd :: Range -> Range -> Range
rangeAdd (Range Maybe Integer
mi1 Maybe Integer
ma1) (Range Maybe Integer
mi2 Maybe Integer
ma2) = Maybe Integer -> Maybe Integer -> Range
Range (Maybe Integer -> Maybe Integer -> Maybe Integer
add Maybe Integer
mi1 Maybe Integer
mi2) (Maybe Integer -> Maybe Integer -> Maybe Integer
add Maybe Integer
ma1 Maybe Integer
ma2)
  where
    add :: Maybe Integer -> Maybe Integer -> Maybe Integer
add = \cases
      (Just Integer
v) (Just Integer
u) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
u)
      Maybe Integer
_        Maybe Integer
_        -> Maybe Integer
forall a. Maybe a
Nothing

-- | Subtraction of two ranges
rangeSub :: Range -> Range -> Range
rangeSub :: Range -> Range -> Range
rangeSub (Range Maybe Integer
mi1 Maybe Integer
ma1) (Range Maybe Integer
mi2 Maybe Integer
ma2) = Maybe Integer -> Maybe Integer -> Range
Range (Maybe Integer -> Maybe Integer -> Maybe Integer
sub Maybe Integer
mi1 Maybe Integer
ma2) (Maybe Integer -> Maybe Integer -> Maybe Integer
sub Maybe Integer
ma1 Maybe Integer
mi2)
  where
    sub :: Maybe Integer -> Maybe Integer -> Maybe Integer
sub = \cases
      (Just Integer
v) (Just Integer
u) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
u)
      Maybe Integer
_        Maybe Integer
_        -> Maybe Integer
forall a. Maybe a
Nothing

-- | Logical AND of two ranges at the given type
{-# NOINLINE rangeAnd #-}
rangeAnd :: forall a. (FiniteBits a, Bounded a, Integral a) => Range -> Range -> Range
rangeAnd :: forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd (Range Maybe Integer
mi1' Maybe Integer
ma1') (Range Maybe Integer
mi2' Maybe Integer
ma2') = Range
final_range
  where
    -- convert the Integer range bounds into the given type with FiniteBits
    -- because we need to work on the actual representation, not on the Integer
    -- value. We also take the minBound/maxBound when a bound is missing.
    mi1, mi2, ma1, ma2 :: a
    mi1 :: a
mi1 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
minBound (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Maybe Integer -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
mi1')
    mi2 :: a
mi2 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
minBound (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Maybe Integer -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
mi2')
    ma1 :: a
ma1 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
maxBound (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Maybe Integer -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
ma1')
    ma2 :: a
ma2 = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Bounded a => a
maxBound (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Maybe Integer -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
ma2')

    -- we compute the minimal number of leading zeros for each range.
    -- Then we take the maximum of both values: this is the number of leading
    -- bits that will always be set to zero in the resulting range.
    clz1 :: Int
clz1 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros a
mi1) (a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros a
ma1)
    clz2 :: Int
clz2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros a
mi2) (a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros a
ma2)
    clzr :: Int
clzr = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
clz1 Int
clz2

    -- we generate a mask for the bits that might be set to 1 in the resulting
    -- range and apply it to every bound. It may reorder the bounds: e.g.
    --    ([-1,1] :: Int8) .&. 0xF ==> [15,1] ==> [1,15]
    -- so we have to be careful when we reconstruct the final range
    mask :: a
    mask :: a
mask = if
      | Int
clzr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
mi1 -> a
forall a. Bits a => a
zeroBits
      | Int
clzr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0                 -> a -> a
forall a. Bits a => a -> a
complement a
forall a. Bits a => a
zeroBits
      | Bool
otherwise                 -> (a
1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
mi1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
clzr)) a -> a -> a
forall a. Num a => a -> a -> a
- a
1
              -- we can't use: complement zeroBits `shiftR` clzr
              -- because shiftR performs sign-extension for signed types
    mk_final_bound :: a -> Integer
mk_final_bound a
x = a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
mask)

    fmi1 :: Integer
fmi1 = a -> Integer
mk_final_bound a
mi1
    fmi2 :: Integer
fmi2 = a -> Integer
mk_final_bound a
mi2
    fma1 :: Integer
fma1 = a -> Integer
mk_final_bound a
ma1
    fma2 :: Integer
fma2 = a -> Integer
mk_final_bound a
ma2
    fmi :: Integer
fmi = Integer
fmi1 Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`min` Integer
fmi2 Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`min` Integer
fma1 Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`min` Integer
fma2
    fma :: Integer
fma = Integer
fmi1 Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`max` Integer
fmi2 Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`max` Integer
fma1 Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
`max` Integer
fma2
    final_range :: Range
final_range = Maybe Integer -> Maybe Integer -> Range
Range (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
fmi) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
fma)


noRange :: Range
noRange :: Range
noRange = Maybe Integer -> Maybe Integer -> Range
Range Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

rangeOf :: forall a. (Bounded a, Integral a) => Range
rangeOf :: forall a. (Bounded a, Integral a) => Range
rangeOf = Maybe Integer -> Maybe Integer -> Range
Range (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a))) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a)))

rangeWord8, rangeWord16, rangeWord32, rangeWord64 :: Range
rangeWord8 :: Range
rangeWord8  = forall a. (Bounded a, Integral a) => Range
rangeOf @Word8
rangeWord16 :: Range
rangeWord16 = forall a. (Bounded a, Integral a) => Range
rangeOf @Word16
rangeWord32 :: Range
rangeWord32 = forall a. (Bounded a, Integral a) => Range
rangeOf @Word32
rangeWord64 :: Range
rangeWord64 = forall a. (Bounded a, Integral a) => Range
rangeOf @Word64

rangeInt8, rangeInt16, rangeInt32, rangeInt64 :: Range
rangeInt8 :: Range
rangeInt8  = forall a. (Bounded a, Integral a) => Range
rangeOf @Int8
rangeInt16 :: Range
rangeInt16 = forall a. (Bounded a, Integral a) => Range
rangeOf @Int16
rangeInt32 :: Range
rangeInt32 = forall a. (Bounded a, Integral a) => Range
rangeOf @Int32
rangeInt64 :: Range
rangeInt64 = forall a. (Bounded a, Integral a) => Range
rangeOf @Int64

rangeWord, rangeInt, rangeChar :: Platform -> Range
rangeWord :: Platform -> Range
rangeWord Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
  PlatformWordSize
PW4 -> Range
rangeWord32
  PlatformWordSize
PW8 -> Range
rangeWord64
rangeInt :: Platform -> Range
rangeInt Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
  PlatformWordSize
PW4 -> Range
rangeInt32
  PlatformWordSize
PW8 -> Range
rangeInt64

rangeChar :: Platform -> Range
rangeChar = Platform -> Range
rangeInt -- a Char# is represented internally as an Int#

-- | Compare two ranges
--
-- See Note [Value range analysis]
rangeCmp :: Comparison -> Range -> Range -> Maybe Bool
rangeCmp :: Comparison -> Range -> Range -> Maybe Bool
rangeCmp Comparison
cmp Range
rx Range
ry = case Comparison
cmp of
  Comparison
Gt -> Range
rx Range -> Range -> Maybe Bool
`rangeGt` Range
ry
  Comparison
Ge -> Range
rx Range -> Range -> Maybe Bool
`rangeGe` Range
ry
  Comparison
Le -> Range
rx Range -> Range -> Maybe Bool
`rangeLe` Range
ry
  Comparison
Lt -> Range
rx Range -> Range -> Maybe Bool
`rangeLt` Range
ry

rangeGt :: Range -> Range -> Maybe Bool
rangeGt :: Range -> Range -> Maybe Bool
rangeGt = \cases
  (Range (Just Integer
mi) Maybe Integer
_) (Range Maybe Integer
_ (Just Integer
ma)) | Integer
mi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
ma  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  (Range Maybe Integer
_ (Just Integer
ma)) (Range (Just Integer
mi) Maybe Integer
_) | Integer
ma Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mi -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  Range
_ Range
_ -> Maybe Bool
forall a. Maybe a
Nothing

rangeLt :: Range -> Range -> Maybe Bool
rangeLt :: Range -> Range -> Maybe Bool
rangeLt = \cases
  (Range Maybe Integer
_ (Just Integer
ma)) (Range (Just Integer
mi) Maybe Integer
_) | Integer
ma Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mi  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  (Range (Just Integer
mi) Maybe Integer
_) (Range Maybe Integer
_ (Just Integer
ma)) | Integer
mi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
ma -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  Range
_ Range
_ -> Maybe Bool
forall a. Maybe a
Nothing

rangeGe :: Range -> Range -> Maybe Bool
rangeGe :: Range -> Range -> Maybe Bool
rangeGe = \cases
  (Range (Just Integer
mi) Maybe Integer
_) (Range Maybe Integer
_ (Just Integer
ma)) | Integer
mi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
ma -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  (Range Maybe Integer
_ (Just Integer
ma)) (Range (Just Integer
mi) Maybe Integer
_) | Integer
ma Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
mi  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  Range
_ Range
_ -> Maybe Bool
forall a. Maybe a
Nothing

rangeLe :: Range -> Range -> Maybe Bool
rangeLe :: Range -> Range -> Maybe Bool
rangeLe = \cases
  (Range Maybe Integer
_ (Just Integer
ma)) (Range (Just Integer
mi) Maybe Integer
_) | Integer
ma Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mi -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  (Range (Just Integer
mi) Maybe Integer
_) (Range Maybe Integer
_ (Just Integer
ma)) | Integer
mi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
ma  -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  Range
_ Range
_ -> Maybe Bool
forall a. Maybe a
Nothing


-- | Return the Integer range of an expression
valueRange :: Platform -> CoreExpr -> Range
valueRange :: Platform -> CoreExpr -> Range
valueRange Platform
platform = Word -> CoreExpr -> Range
value_range Word
10
  where
    -- we use some fuel value to avoid recursing infinitely
    value_range :: Word -> CoreExpr -> Range
    value_range :: Word -> CoreExpr -> Range
value_range Word
fuel CoreExpr
expr
      | Word
fuel Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 = Range
noRange
      | Bool
otherwise = case CoreExpr
expr of
          Lit (LitNumber LitNumType
_ Integer
n) -> Maybe Integer -> Maybe Integer -> Range
Range (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n)
          Lit (LitChar Char
c) -> let n :: Integer
n = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) in Maybe Integer -> Maybe Integer -> Range
Range (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n) (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
n)
          Lit Literal
_ -> Range
noRange
          Var Id
v
            | Just CoreExpr
ebody <- Unfolding -> Maybe CoreExpr
expandUnfolding_always (IdUnfoldingFun
idUnfolding Id
v)
            -> Word -> CoreExpr -> Range
value_range (Word
fuelWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) CoreExpr
ebody
            | Bool
otherwise
            -> Range
noRange
          PrimOpVar PrimOp
op `App` CoreExpr
x ->
            let sub_range :: Range
sub_range = Word -> CoreExpr -> Range
value_range (Word
fuelWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) CoreExpr
x
            in case PrimOp
op of
              PrimOp
Word8ToWordOp  -> Range
rangeWord8  Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Word16ToWordOp -> Range
rangeWord16 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Word32ToWordOp -> Range
rangeWord32 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Word64ToWordOp -> Platform -> Range
rangeWord Platform
platform Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
WordToWord8Op  -> Range
rangeWord8  Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
WordToWord16Op -> Range
rangeWord16 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
WordToWord32Op -> Range
rangeWord32 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
WordToWord64Op -> Platform -> Range
rangeWord Platform
platform Range -> Range -> Range
`rangeIntersect` Range
sub_range

              PrimOp
Word8ToInt8Op   -> Range
rangeInt8  Range -> Range -> Range
`rangeCastFrom` (Range
rangeWord8  Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
Word16ToInt16Op -> Range
rangeInt16 Range -> Range -> Range
`rangeCastFrom` (Range
rangeWord16 Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
Word32ToInt32Op -> Range
rangeInt32 Range -> Range -> Range
`rangeCastFrom` (Range
rangeWord32 Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
Word64ToInt64Op -> Range
rangeInt64 Range -> Range -> Range
`rangeCastFrom` (Range
rangeWord64 Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
WordToIntOp     -> Platform -> Range
rangeInt Platform
platform Range -> Range -> Range
`rangeCastFrom` (Platform -> Range
rangeWord Platform
platform  Range -> Range -> Range
`rangeIntersect` Range
sub_range)

              PrimOp
Int8ToWord8Op   -> Range
rangeWord8  Range -> Range -> Range
`rangeCastFrom` (Range
rangeInt8  Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
Int16ToWord16Op -> Range
rangeWord16 Range -> Range -> Range
`rangeCastFrom` (Range
rangeInt16 Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
Int32ToWord32Op -> Range
rangeWord32 Range -> Range -> Range
`rangeCastFrom` (Range
rangeInt32 Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
Int64ToWord64Op -> Range
rangeWord64 Range -> Range -> Range
`rangeCastFrom` (Range
rangeInt64 Range -> Range -> Range
`rangeIntersect` Range
sub_range)
              PrimOp
IntToWordOp     -> Platform -> Range
rangeWord Platform
platform Range -> Range -> Range
`rangeCastFrom` (Platform -> Range
rangeInt Platform
platform Range -> Range -> Range
`rangeIntersect` Range
sub_range)

              PrimOp
Narrow8IntOp   -> Range
rangeInt8 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Narrow16IntOp  -> Range
rangeInt16 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Narrow32IntOp  -> Range
rangeInt32 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Narrow8WordOp  -> Range
rangeWord8 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Narrow16WordOp -> Range
rangeWord16 Range -> Range -> Range
`rangeIntersect` Range
sub_range
              PrimOp
Narrow32WordOp -> Range
rangeWord32 Range -> Range -> Range
`rangeIntersect` Range
sub_range

              PrimOp
OrdOp          -> Range
sub_range
              PrimOp
ChrOp          -> Range
sub_range

              PrimOp
_              -> Range
noRange

          PrimOpVar PrimOp
op `App` CoreExpr
x `App` CoreExpr
y ->
            let range_x :: Range
range_x = Word -> CoreExpr -> Range
value_range (Word
fuelWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) CoreExpr
x
                range_y :: Range
range_y = Word -> CoreExpr -> Range
value_range (Word
fuelWord -> Word -> Word
forall a. Num a => a -> a -> a
-Word
1) CoreExpr
y
            in case PrimOp
op of
              PrimOp
Word8AddOp  -> Range
rangeWord8 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
Word16AddOp -> Range
rangeWord16 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
Word32AddOp -> Range
rangeWord32 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
Word64AddOp -> Range
rangeWord64 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
WordAddOp   -> Platform -> Range
rangeWord Platform
platform Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
Int8AddOp   -> Range
rangeInt8 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
Int16AddOp  -> Range
rangeInt16 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
Int32AddOp  -> Range
rangeInt32 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
Int64AddOp  -> Range
rangeInt64 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y
              PrimOp
IntAddOp    -> Platform -> Range
rangeInt Platform
platform Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeAdd Range
range_x Range
range_y

              PrimOp
Word8SubOp  -> Range
rangeWord8 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
Word16SubOp -> Range
rangeWord16 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
Word32SubOp -> Range
rangeWord32 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
Word64SubOp -> Range
rangeWord64 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
WordSubOp   -> Platform -> Range
rangeWord Platform
platform Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
Int8SubOp   -> Range
rangeInt8 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
Int16SubOp  -> Range
rangeInt16 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
Int32SubOp  -> Range
rangeInt32 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
Int64SubOp  -> Range
rangeInt64 Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y
              PrimOp
IntSubOp    -> Platform -> Range
rangeInt Platform
platform Range -> Range -> Range
`rangeCastFrom` Range -> Range -> Range
rangeSub Range
range_x Range
range_y

              PrimOp
IntAndOp -> case Platform -> PlatformWordSize
platformWordSize Platform
platform of
                PlatformWordSize
PW4 -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Int32 Range
range_x Range
range_y
                PlatformWordSize
PW8 -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Int64 Range
range_x Range
range_y
              PrimOp
WordAndOp -> case Platform -> PlatformWordSize
platformWordSize Platform
platform of
                PlatformWordSize
PW4 -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Word32 Range
range_x Range
range_y
                PlatformWordSize
PW8 -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Word64 Range
range_x Range
range_y
              PrimOp
Word8AndOp  -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Word8  Range
range_x Range
range_y
              PrimOp
Word16AndOp -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Word16 Range
range_x Range
range_y
              PrimOp
Word32AndOp -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Word32 Range
range_x Range
range_y
              PrimOp
Word64AndOp -> forall a.
(FiniteBits a, Bounded a, Integral a) =>
Range -> Range -> Range
rangeAnd @Word64 Range
range_x Range
range_y

              -- TODO: shifts, or, clz, ctz, negate...
              PrimOp
_ -> Range
noRange

          App {}      -> Range
noRange
          Lam {}      -> Range
noRange
          Let {}      -> Range
noRange
          Case {}     -> Range
noRange
          Cast CoreExpr
e CoercionR
_    -> Word -> CoreExpr -> Range
value_range Word
fuel CoreExpr
e
          Tick CoreTickish
_ CoreExpr
e    -> Word -> CoreExpr -> Range
value_range Word
fuel CoreExpr
e
          Type {}     -> Range
noRange
          Coercion {} -> Range
noRange

-- | Match a primop
pattern PrimOpVar:: PrimOp -> Arg CoreBndr
pattern $mPrimOpVar :: forall {r}. CoreExpr -> (PrimOp -> r) -> ((# #) -> r) -> r
$bPrimOpVar :: PrimOp -> CoreExpr
PrimOpVar op <- Var (isPrimOpId_maybe -> Just op) where
   PrimOpVar PrimOp
op = Id -> CoreExpr
forall b. Id -> Expr b
Var (PrimOp -> Id
primOpId PrimOp
op)