{-# LANGUAGE DeriveDataTypeable #-}

-- | Source text
--
-- Keeping Source Text for source to source conversions
--
module GHC.Types.SourceText
   ( SourceText (..)
   , pprWithSourceText

   -- * Literals
   , IntegralLit(..)
   , FractionalLit(..)
   , StringLiteral(..)
   , negateIntegralLit
   , negateFractionalLit
   , mkIntegralLit
   , mkTHFractionalLit, rationalFromFractionalLit
   , integralFractionalLit, mkSourceFractionalLit
   , FractionalExponentBase(..)

   -- Used by the pm checker.
   , fractionalLitFromRational
   , mkFractionalLit

   )
where

import GHC.Prelude

import GHC.Data.FastString

import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Utils.Panic

import Data.Function (on)
import Data.Data
import GHC.Real ( Ratio(..) )
import GHC.Types.SrcLoc

{-
Note [Pragma source text]
~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer does a case-insensitive match for pragmas, as well as
accepting both UK and US spelling variants.

So

  {-# SPECIALISE #-}
  {-# SPECIALIZE #-}
  {-# Specialize #-}

will all generate ITspec_prag token for the start of the pragma.

In order to be able to do source to source conversions, the original
source text for the token needs to be preserved, hence the
`SourceText` field.

So the lexer will then generate

  ITspec_prag "{ -# SPECIALISE"
  ITspec_prag "{ -# SPECIALIZE"
  ITspec_prag "{ -# Specialize"

for the cases above.
 [without the space between '{' and '-', otherwise this comment won't parse]


Note [Literal source text]
~~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer/parser converts literals from their original source text
versions to an appropriate internal representation. This is a problem
for tools doing source to source conversions, so the original source
text is stored in literals where this can occur.

Motivating examples for HsLit

  HsChar          '\n'       == '\x20`
  HsCharPrim      '\x41`#    == `A`
  HsString        "\x20\x41" == " A"
  HsStringPrim    "\x20"#    == " "#
  HsInt           001        == 1
  HsIntPrim       002#       == 2#
  HsWordPrim      003##      == 3##
  HsInt64Prim     004##      == 4##
  HsWord64Prim    005##      == 5##
  HsInteger       006        == 6

For OverLitVal

  HsIntegral      003      == 0x003
  HsIsString      "\x41nd" == "And"
-}

 -- Note [Literal source text],[Pragma source text]
data SourceText
   = SourceText String
   | NoSourceText
      -- ^ For when code is generated, e.g. TH,
      -- deriving. The pretty printer will then make
      -- its own representation of the item.
   deriving (Typeable SourceText
Typeable SourceText
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SourceText -> c SourceText)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceText)
-> (SourceText -> Constr)
-> (SourceText -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceText))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceText))
-> ((forall b. Data b => b -> b) -> SourceText -> SourceText)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceText -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceText -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourceText -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceText -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourceText -> m SourceText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceText -> m SourceText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceText -> m SourceText)
-> Data SourceText
SourceText -> Constr
SourceText -> DataType
(forall b. Data b => b -> b) -> SourceText -> SourceText
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceText -> u
forall u. (forall d. Data d => d -> u) -> SourceText -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceText
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceText -> c SourceText
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceText)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceText)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceText -> c SourceText
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceText -> c SourceText
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceText
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceText
$ctoConstr :: SourceText -> Constr
toConstr :: SourceText -> Constr
$cdataTypeOf :: SourceText -> DataType
dataTypeOf :: SourceText -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceText)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceText)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceText)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceText)
$cgmapT :: (forall b. Data b => b -> b) -> SourceText -> SourceText
gmapT :: (forall b. Data b => b -> b) -> SourceText -> SourceText
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceText -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SourceText -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceText -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceText -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
Data, Int -> SourceText -> ShowS
[SourceText] -> ShowS
SourceText -> String
(Int -> SourceText -> ShowS)
-> (SourceText -> String)
-> ([SourceText] -> ShowS)
-> Show SourceText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceText -> ShowS
showsPrec :: Int -> SourceText -> ShowS
$cshow :: SourceText -> String
show :: SourceText -> String
$cshowList :: [SourceText] -> ShowS
showList :: [SourceText] -> ShowS
Show, SourceText -> SourceText -> Bool
(SourceText -> SourceText -> Bool)
-> (SourceText -> SourceText -> Bool) -> Eq SourceText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceText -> SourceText -> Bool
== :: SourceText -> SourceText -> Bool
$c/= :: SourceText -> SourceText -> Bool
/= :: SourceText -> SourceText -> Bool
Eq )

instance Outputable SourceText where
  ppr :: SourceText -> SDoc
ppr (SourceText String
s) = String -> SDoc
text String
"SourceText" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
s
  ppr SourceText
NoSourceText   = String -> SDoc
text String
"NoSourceText"

instance Binary SourceText where
  put_ :: BinHandle -> SourceText -> IO ()
put_ BinHandle
bh SourceText
NoSourceText = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
  put_ BinHandle
bh (SourceText String
s) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
        BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
s

  get :: BinHandle -> IO SourceText
get BinHandle
bh = do
    Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
h of
      Word8
0 -> SourceText -> IO SourceText
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SourceText
NoSourceText
      Word8
1 -> do
        String
s <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        SourceText -> IO SourceText
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SourceText
SourceText String
s)
      Word8
_ -> String -> IO SourceText
forall a. String -> a
panic (String -> IO SourceText) -> String -> IO SourceText
forall a b. (a -> b) -> a -> b
$ String
"Binary SourceText:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
h

-- | Special combinator for showing string literals.
pprWithSourceText :: SourceText -> SDoc -> SDoc
pprWithSourceText :: SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
NoSourceText     SDoc
d = SDoc
d
pprWithSourceText (SourceText String
src) SDoc
_ = String -> SDoc
text String
src

------------------------------------------------
-- Literals
------------------------------------------------

-- | Integral Literal
--
-- Used (instead of Integer) to represent negative zegative zero which is
-- required for NegativeLiterals extension to correctly parse `-0::Double`
-- as negative zero. See also #13211.
data IntegralLit = IL
   { IntegralLit -> SourceText
il_text  :: SourceText
   , IntegralLit -> Bool
il_neg   :: Bool -- See Note [Negative zero] in GHC.Rename.Pat
   , IntegralLit -> Integer
il_value :: Integer
   }
   deriving (Typeable IntegralLit
Typeable IntegralLit
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IntegralLit -> c IntegralLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IntegralLit)
-> (IntegralLit -> Constr)
-> (IntegralLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IntegralLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IntegralLit))
-> ((forall b. Data b => b -> b) -> IntegralLit -> IntegralLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IntegralLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IntegralLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> IntegralLit -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IntegralLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit)
-> Data IntegralLit
IntegralLit -> Constr
IntegralLit -> DataType
(forall b. Data b => b -> b) -> IntegralLit -> IntegralLit
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IntegralLit -> u
forall u. (forall d. Data d => d -> u) -> IntegralLit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegralLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegralLit -> c IntegralLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IntegralLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IntegralLit)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegralLit -> c IntegralLit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegralLit -> c IntegralLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegralLit
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegralLit
$ctoConstr :: IntegralLit -> Constr
toConstr :: IntegralLit -> Constr
$cdataTypeOf :: IntegralLit -> DataType
dataTypeOf :: IntegralLit -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IntegralLit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IntegralLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IntegralLit)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IntegralLit)
$cgmapT :: (forall b. Data b => b -> b) -> IntegralLit -> IntegralLit
gmapT :: (forall b. Data b => b -> b) -> IntegralLit -> IntegralLit
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IntegralLit -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> IntegralLit -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IntegralLit -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IntegralLit -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
Data, Int -> IntegralLit -> ShowS
[IntegralLit] -> ShowS
IntegralLit -> String
(Int -> IntegralLit -> ShowS)
-> (IntegralLit -> String)
-> ([IntegralLit] -> ShowS)
-> Show IntegralLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntegralLit -> ShowS
showsPrec :: Int -> IntegralLit -> ShowS
$cshow :: IntegralLit -> String
show :: IntegralLit -> String
$cshowList :: [IntegralLit] -> ShowS
showList :: [IntegralLit] -> ShowS
Show)

mkIntegralLit :: Integral a => a -> IntegralLit
mkIntegralLit :: forall a. Integral a => a -> IntegralLit
mkIntegralLit a
i = IL { il_text :: SourceText
il_text = String -> SourceText
SourceText (Integer -> String
forall a. Show a => a -> String
show Integer
i_integer)
                     , il_neg :: Bool
il_neg = a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0
                     , il_value :: Integer
il_value = Integer
i_integer }
  where
    i_integer :: Integer
    i_integer :: Integer
i_integer = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
i

negateIntegralLit :: IntegralLit -> IntegralLit
negateIntegralLit :: IntegralLit -> IntegralLit
negateIntegralLit (IL SourceText
text Bool
neg Integer
value)
  = case SourceText
text of
      SourceText (Char
'-':String
src) -> SourceText -> Bool -> Integer -> IntegralLit
IL (String -> SourceText
SourceText String
src)       Bool
False    (Integer -> Integer
forall a. Num a => a -> a
negate Integer
value)
      SourceText      String
src  -> SourceText -> Bool -> Integer -> IntegralLit
IL (String -> SourceText
SourceText (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:String
src)) Bool
True     (Integer -> Integer
forall a. Num a => a -> a
negate Integer
value)
      SourceText
NoSourceText         -> SourceText -> Bool -> Integer -> IntegralLit
IL SourceText
NoSourceText          (Bool -> Bool
not Bool
neg) (Integer -> Integer
forall a. Num a => a -> a
negate Integer
value)

-- | Fractional Literal
--
-- Used (instead of Rational) to represent exactly the floating point literal that we
-- encountered in the user's source program. This allows us to pretty-print exactly what
-- the user wrote, which is important e.g. for floating point numbers that can't represented
-- as Doubles (we used to via Double for pretty-printing). See also #2245.
-- Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
-- The actual value then is: sign * fl_signi * (fl_exp_base^fl_exp)
--                             where sign = if fl_neg then (-1) else 1
--
-- For example FL { fl_neg = True, fl_signi = 5.3, fl_exp = 4, fl_exp_base = Base10 }
-- denotes  -5300

data FractionalLit = FL
    { FractionalLit -> SourceText
fl_text :: SourceText     -- ^ How the value was written in the source
    , FractionalLit -> Bool
fl_neg :: Bool                        -- See Note [Negative zero]
    , FractionalLit -> Rational
fl_signi :: Rational                  -- The significand component of the literal
    , FractionalLit -> Integer
fl_exp :: Integer                     -- The exponent component of the literal
    , FractionalLit -> FractionalExponentBase
fl_exp_base :: FractionalExponentBase -- See Note [fractional exponent bases]
    }
    deriving (Typeable FractionalLit
Typeable FractionalLit
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FractionalLit -> c FractionalLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FractionalLit)
-> (FractionalLit -> Constr)
-> (FractionalLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FractionalLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FractionalLit))
-> ((forall b. Data b => b -> b) -> FractionalLit -> FractionalLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FractionalLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FractionalLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> FractionalLit -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FractionalLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit)
-> Data FractionalLit
FractionalLit -> Constr
FractionalLit -> DataType
(forall b. Data b => b -> b) -> FractionalLit -> FractionalLit
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FractionalLit -> u
forall u. (forall d. Data d => d -> u) -> FractionalLit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FractionalLit -> c FractionalLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalLit)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FractionalLit -> c FractionalLit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FractionalLit -> c FractionalLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalLit
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalLit
$ctoConstr :: FractionalLit -> Constr
toConstr :: FractionalLit -> Constr
$cdataTypeOf :: FractionalLit -> DataType
dataTypeOf :: FractionalLit -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalLit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalLit)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalLit)
$cgmapT :: (forall b. Data b => b -> b) -> FractionalLit -> FractionalLit
gmapT :: (forall b. Data b => b -> b) -> FractionalLit -> FractionalLit
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FractionalLit -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FractionalLit -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FractionalLit -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FractionalLit -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
Data, Int -> FractionalLit -> ShowS
[FractionalLit] -> ShowS
FractionalLit -> String
(Int -> FractionalLit -> ShowS)
-> (FractionalLit -> String)
-> ([FractionalLit] -> ShowS)
-> Show FractionalLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FractionalLit -> ShowS
showsPrec :: Int -> FractionalLit -> ShowS
$cshow :: FractionalLit -> String
show :: FractionalLit -> String
$cshowList :: [FractionalLit] -> ShowS
showList :: [FractionalLit] -> ShowS
Show)
  -- The Show instance is required for the derived GHC.Parser.Lexer.Token instance when DEBUG is on

-- See Note [FractionalLit representation] in GHC.HsToCore.Match.Literal
data FractionalExponentBase
  = Base2 -- Used in hex fractional literals
  | Base10
  deriving (FractionalExponentBase -> FractionalExponentBase -> Bool
(FractionalExponentBase -> FractionalExponentBase -> Bool)
-> (FractionalExponentBase -> FractionalExponentBase -> Bool)
-> Eq FractionalExponentBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FractionalExponentBase -> FractionalExponentBase -> Bool
== :: FractionalExponentBase -> FractionalExponentBase -> Bool
$c/= :: FractionalExponentBase -> FractionalExponentBase -> Bool
/= :: FractionalExponentBase -> FractionalExponentBase -> Bool
Eq, Eq FractionalExponentBase
Eq FractionalExponentBase
-> (FractionalExponentBase -> FractionalExponentBase -> Ordering)
-> (FractionalExponentBase -> FractionalExponentBase -> Bool)
-> (FractionalExponentBase -> FractionalExponentBase -> Bool)
-> (FractionalExponentBase -> FractionalExponentBase -> Bool)
-> (FractionalExponentBase -> FractionalExponentBase -> Bool)
-> (FractionalExponentBase
    -> FractionalExponentBase -> FractionalExponentBase)
-> (FractionalExponentBase
    -> FractionalExponentBase -> FractionalExponentBase)
-> Ord FractionalExponentBase
FractionalExponentBase -> FractionalExponentBase -> Bool
FractionalExponentBase -> FractionalExponentBase -> Ordering
FractionalExponentBase
-> FractionalExponentBase -> FractionalExponentBase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FractionalExponentBase -> FractionalExponentBase -> Ordering
compare :: FractionalExponentBase -> FractionalExponentBase -> Ordering
$c< :: FractionalExponentBase -> FractionalExponentBase -> Bool
< :: FractionalExponentBase -> FractionalExponentBase -> Bool
$c<= :: FractionalExponentBase -> FractionalExponentBase -> Bool
<= :: FractionalExponentBase -> FractionalExponentBase -> Bool
$c> :: FractionalExponentBase -> FractionalExponentBase -> Bool
> :: FractionalExponentBase -> FractionalExponentBase -> Bool
$c>= :: FractionalExponentBase -> FractionalExponentBase -> Bool
>= :: FractionalExponentBase -> FractionalExponentBase -> Bool
$cmax :: FractionalExponentBase
-> FractionalExponentBase -> FractionalExponentBase
max :: FractionalExponentBase
-> FractionalExponentBase -> FractionalExponentBase
$cmin :: FractionalExponentBase
-> FractionalExponentBase -> FractionalExponentBase
min :: FractionalExponentBase
-> FractionalExponentBase -> FractionalExponentBase
Ord, Typeable FractionalExponentBase
Typeable FractionalExponentBase
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> FractionalExponentBase
    -> c FractionalExponentBase)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FractionalExponentBase)
-> (FractionalExponentBase -> Constr)
-> (FractionalExponentBase -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FractionalExponentBase))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FractionalExponentBase))
-> ((forall b. Data b => b -> b)
    -> FractionalExponentBase -> FractionalExponentBase)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> FractionalExponentBase
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> FractionalExponentBase
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> FractionalExponentBase -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FractionalExponentBase -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> FractionalExponentBase -> m FractionalExponentBase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FractionalExponentBase -> m FractionalExponentBase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> FractionalExponentBase -> m FractionalExponentBase)
-> Data FractionalExponentBase
FractionalExponentBase -> Constr
FractionalExponentBase -> DataType
(forall b. Data b => b -> b)
-> FractionalExponentBase -> FractionalExponentBase
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> FractionalExponentBase -> u
forall u.
(forall d. Data d => d -> u) -> FractionalExponentBase -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FractionalExponentBase
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FractionalExponentBase
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalExponentBase
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FractionalExponentBase
-> c FractionalExponentBase
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalExponentBase)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalExponentBase)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FractionalExponentBase
-> c FractionalExponentBase
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FractionalExponentBase
-> c FractionalExponentBase
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalExponentBase
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalExponentBase
$ctoConstr :: FractionalExponentBase -> Constr
toConstr :: FractionalExponentBase -> Constr
$cdataTypeOf :: FractionalExponentBase -> DataType
dataTypeOf :: FractionalExponentBase -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalExponentBase)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalExponentBase)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalExponentBase)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalExponentBase)
$cgmapT :: (forall b. Data b => b -> b)
-> FractionalExponentBase -> FractionalExponentBase
gmapT :: (forall b. Data b => b -> b)
-> FractionalExponentBase -> FractionalExponentBase
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FractionalExponentBase
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> FractionalExponentBase
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FractionalExponentBase
-> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> FractionalExponentBase
-> r
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> FractionalExponentBase -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FractionalExponentBase -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FractionalExponentBase -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FractionalExponentBase -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FractionalExponentBase -> m FractionalExponentBase
Data, Int -> FractionalExponentBase -> ShowS
[FractionalExponentBase] -> ShowS
FractionalExponentBase -> String
(Int -> FractionalExponentBase -> ShowS)
-> (FractionalExponentBase -> String)
-> ([FractionalExponentBase] -> ShowS)
-> Show FractionalExponentBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FractionalExponentBase -> ShowS
showsPrec :: Int -> FractionalExponentBase -> ShowS
$cshow :: FractionalExponentBase -> String
show :: FractionalExponentBase -> String
$cshowList :: [FractionalExponentBase] -> ShowS
showList :: [FractionalExponentBase] -> ShowS
Show)

mkFractionalLit :: SourceText -> Bool -> Rational -> Integer -> FractionalExponentBase
                -> FractionalLit
mkFractionalLit :: SourceText
-> Bool
-> Rational
-> Integer
-> FractionalExponentBase
-> FractionalLit
mkFractionalLit = SourceText
-> Bool
-> Rational
-> Integer
-> FractionalExponentBase
-> FractionalLit
FL

mkRationalWithExponentBase :: Rational -> Integer -> FractionalExponentBase -> Rational
mkRationalWithExponentBase :: Rational -> Integer -> FractionalExponentBase -> Rational
mkRationalWithExponentBase Rational
i Integer
e FractionalExponentBase
feb = Rational
i Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
eb Rational -> Integer -> Rational
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ Integer
e)
  where eb :: Rational
eb = case FractionalExponentBase
feb of FractionalExponentBase
Base2 -> Rational
2 ; FractionalExponentBase
Base10 -> Rational
10

fractionalLitFromRational :: Rational -> FractionalLit
fractionalLitFromRational :: Rational -> FractionalLit
fractionalLitFromRational Rational
r =  FL { fl_text :: SourceText
fl_text = SourceText
NoSourceText
                           , fl_neg :: Bool
fl_neg = Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0
                           , fl_signi :: Rational
fl_signi = Rational
r
                           , fl_exp :: Integer
fl_exp = Integer
0
                           , fl_exp_base :: FractionalExponentBase
fl_exp_base = FractionalExponentBase
Base10 }

rationalFromFractionalLit :: FractionalLit -> Rational
rationalFromFractionalLit :: FractionalLit -> Rational
rationalFromFractionalLit (FL SourceText
_ Bool
_ Rational
i Integer
e FractionalExponentBase
expBase) =
  Rational -> Integer -> FractionalExponentBase -> Rational
mkRationalWithExponentBase Rational
i Integer
e FractionalExponentBase
expBase

mkTHFractionalLit :: Rational -> FractionalLit
mkTHFractionalLit :: Rational -> FractionalLit
mkTHFractionalLit Rational
r =  FL { fl_text :: SourceText
fl_text = String -> SourceText
SourceText (Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Rational
r::Double))
                             -- Converting to a Double here may technically lose
                             -- precision (see #15502). We could alternatively
                             -- convert to a Rational for the most accuracy, but
                             -- it would cause Floats and Doubles to be displayed
                             -- strangely, so we opt not to do this. (In contrast
                             -- to mkIntegralLit, where we always convert to an
                             -- Integer for the highest accuracy.)
                           , fl_neg :: Bool
fl_neg = Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0
                           , fl_signi :: Rational
fl_signi = Rational
r
                           , fl_exp :: Integer
fl_exp = Integer
0
                           , fl_exp_base :: FractionalExponentBase
fl_exp_base = FractionalExponentBase
Base10 }

negateFractionalLit :: FractionalLit -> FractionalLit
negateFractionalLit :: FractionalLit -> FractionalLit
negateFractionalLit (FL SourceText
text Bool
neg Rational
i Integer
e FractionalExponentBase
eb)
  = case SourceText
text of
      SourceText (Char
'-':String
src) -> SourceText
-> Bool
-> Rational
-> Integer
-> FractionalExponentBase
-> FractionalLit
FL (String -> SourceText
SourceText String
src)       Bool
False (Rational -> Rational
forall a. Num a => a -> a
negate Rational
i) Integer
e FractionalExponentBase
eb
      SourceText      String
src  -> SourceText
-> Bool
-> Rational
-> Integer
-> FractionalExponentBase
-> FractionalLit
FL (String -> SourceText
SourceText (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:String
src)) Bool
True  (Rational -> Rational
forall a. Num a => a -> a
negate Rational
i) Integer
e FractionalExponentBase
eb
      SourceText
NoSourceText         -> SourceText
-> Bool
-> Rational
-> Integer
-> FractionalExponentBase
-> FractionalLit
FL SourceText
NoSourceText (Bool -> Bool
not Bool
neg) (Rational -> Rational
forall a. Num a => a -> a
negate Rational
i) Integer
e FractionalExponentBase
eb

-- | The integer should already be negated if it's negative.
integralFractionalLit :: Bool -> Integer -> FractionalLit
integralFractionalLit :: Bool -> Integer -> FractionalLit
integralFractionalLit Bool
neg Integer
i = FL { fl_text :: SourceText
fl_text = String -> SourceText
SourceText (Integer -> String
forall a. Show a => a -> String
show Integer
i)
                                 , fl_neg :: Bool
fl_neg = Bool
neg
                                 , fl_signi :: Rational
fl_signi = Integer
i Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
1
                                 , fl_exp :: Integer
fl_exp = Integer
0
                                 , fl_exp_base :: FractionalExponentBase
fl_exp_base = FractionalExponentBase
Base10 }

-- | The arguments should already be negated if they are negative.
mkSourceFractionalLit :: String -> Bool -> Integer -> Integer
                      -> FractionalExponentBase
                      -> FractionalLit
mkSourceFractionalLit :: String
-> Bool
-> Integer
-> Integer
-> FractionalExponentBase
-> FractionalLit
mkSourceFractionalLit !String
str !Bool
b !Integer
r !Integer
i !FractionalExponentBase
ff = SourceText
-> Bool
-> Rational
-> Integer
-> FractionalExponentBase
-> FractionalLit
FL (String -> SourceText
SourceText String
str) Bool
b (Integer
r Integer -> Integer -> Rational
forall a. a -> a -> Ratio a
:% Integer
1) Integer
i FractionalExponentBase
ff

{- Note [fractional exponent bases]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For hexadecimal rationals of
the form 0x0.3p10 the exponent is given on base 2 rather than
base 10. These are the only options, hence the sum type. See also #15646.
-}


-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)

instance Eq IntegralLit where
  == :: IntegralLit -> IntegralLit -> Bool
(==) = Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Integer -> Integer -> Bool)
-> (IntegralLit -> Integer) -> IntegralLit -> IntegralLit -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IntegralLit -> Integer
il_value

instance Ord IntegralLit where
  compare :: IntegralLit -> IntegralLit -> Ordering
compare = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Integer -> Ordering)
-> (IntegralLit -> Integer)
-> IntegralLit
-> IntegralLit
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IntegralLit -> Integer
il_value

instance Outputable IntegralLit where
  ppr :: IntegralLit -> SDoc
ppr (IL (SourceText String
src) Bool
_ Integer
_) = String -> SDoc
text String
src
  ppr (IL SourceText
NoSourceText Bool
_ Integer
value) = String -> SDoc
text (Integer -> String
forall a. Show a => a -> String
show Integer
value)


-- | Compare fractional lits with small exponents for value equality but
--   large values for syntactic equality.
compareFractionalLit :: FractionalLit -> FractionalLit -> Ordering
compareFractionalLit :: FractionalLit -> FractionalLit -> Ordering
compareFractionalLit FractionalLit
fl1 FractionalLit
fl2
  | FractionalLit -> Integer
fl_exp FractionalLit
fl1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
100 Bool -> Bool -> Bool
&& FractionalLit -> Integer
fl_exp FractionalLit
fl2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
100 Bool -> Bool -> Bool
&& FractionalLit -> Integer
fl_exp FractionalLit
fl1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
100 Bool -> Bool -> Bool
&& FractionalLit -> Integer
fl_exp FractionalLit
fl2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= -Integer
100
    = FractionalLit -> Rational
rationalFromFractionalLit FractionalLit
fl1 Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` FractionalLit -> Rational
rationalFromFractionalLit FractionalLit
fl2
  | Bool
otherwise = ((Rational, Integer, FractionalExponentBase)
-> (Rational, Integer, FractionalExponentBase) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Rational, Integer, FractionalExponentBase)
 -> (Rational, Integer, FractionalExponentBase) -> Ordering)
-> (FractionalLit -> (Rational, Integer, FractionalExponentBase))
-> FractionalLit
-> FractionalLit
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\FractionalLit
x -> (FractionalLit -> Rational
fl_signi FractionalLit
x, FractionalLit -> Integer
fl_exp FractionalLit
x, FractionalLit -> FractionalExponentBase
fl_exp_base FractionalLit
x))) FractionalLit
fl1 FractionalLit
fl2

-- | Be wary of using this instance to compare for equal *values* when exponents are
-- large. The same value expressed in different syntactic form won't compare as equal when
-- any of the exponents is >= 100.
instance Eq FractionalLit where
  == :: FractionalLit -> FractionalLit -> Bool
(==) FractionalLit
fl1 FractionalLit
fl2 = case FractionalLit -> FractionalLit -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FractionalLit
fl1 FractionalLit
fl2 of
          Ordering
EQ -> Bool
True
          Ordering
_  -> Bool
False

-- | Be wary of using this instance to compare for equal *values* when exponents are
-- large. The same value expressed in different syntactic form won't compare as equal when
-- any of the exponents is >= 100.
instance Ord FractionalLit where
  compare :: FractionalLit -> FractionalLit -> Ordering
compare = FractionalLit -> FractionalLit -> Ordering
compareFractionalLit

instance Outputable FractionalLit where
  ppr :: FractionalLit -> SDoc
ppr (fl :: FractionalLit
fl@(FL {})) =
    SourceText -> SDoc -> SDoc
pprWithSourceText (FractionalLit -> SourceText
fl_text FractionalLit
fl) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      Rational -> SDoc
rational (Rational -> SDoc) -> Rational -> SDoc
forall a b. (a -> b) -> a -> b
$ Rational -> Integer -> FractionalExponentBase -> Rational
mkRationalWithExponentBase (FractionalLit -> Rational
fl_signi FractionalLit
fl) (FractionalLit -> Integer
fl_exp FractionalLit
fl) (FractionalLit -> FractionalExponentBase
fl_exp_base FractionalLit
fl)

-- | A String Literal in the source, including its original raw format for use by
-- source to source manipulation tools.
data StringLiteral = StringLiteral
                       { StringLiteral -> SourceText
sl_st :: SourceText, -- literal raw source.
                                              -- See not [Literal source text]
                         StringLiteral -> FastString
sl_fs :: FastString, -- literal string value
                         StringLiteral -> Maybe RealSrcSpan
sl_tc :: Maybe RealSrcSpan -- Location of
                                                    -- possible
                                                    -- trailing comma
                       -- AZ: if we could have a LocatedA
                       -- StringLiteral we would not need sl_tc, but
                       -- that would cause import loops.

                       -- AZ:2: sl_tc should be an EpaAnchor, to allow
                       -- editing and reprinting the AST. Need a more
                       -- robust solution.

                       } deriving Typeable StringLiteral
Typeable StringLiteral
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> StringLiteral -> c StringLiteral)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StringLiteral)
-> (StringLiteral -> Constr)
-> (StringLiteral -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StringLiteral))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StringLiteral))
-> ((forall b. Data b => b -> b) -> StringLiteral -> StringLiteral)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StringLiteral -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StringLiteral -> r)
-> (forall u. (forall d. Data d => d -> u) -> StringLiteral -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StringLiteral -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral)
-> Data StringLiteral
StringLiteral -> Constr
StringLiteral -> DataType
(forall b. Data b => b -> b) -> StringLiteral -> StringLiteral
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StringLiteral -> u
forall u. (forall d. Data d => d -> u) -> StringLiteral -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteral
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StringLiteral -> c StringLiteral
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StringLiteral)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteral)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StringLiteral -> c StringLiteral
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StringLiteral -> c StringLiteral
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteral
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteral
$ctoConstr :: StringLiteral -> Constr
toConstr :: StringLiteral -> Constr
$cdataTypeOf :: StringLiteral -> DataType
dataTypeOf :: StringLiteral -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StringLiteral)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StringLiteral)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteral)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteral)
$cgmapT :: (forall b. Data b => b -> b) -> StringLiteral -> StringLiteral
gmapT :: (forall b. Data b => b -> b) -> StringLiteral -> StringLiteral
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StringLiteral -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> StringLiteral -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StringLiteral -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StringLiteral -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
Data

instance Eq StringLiteral where
  (StringLiteral SourceText
_ FastString
a Maybe RealSrcSpan
_) == :: StringLiteral -> StringLiteral -> Bool
== (StringLiteral SourceText
_ FastString
b Maybe RealSrcSpan
_) = FastString
a FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
b

instance Outputable StringLiteral where
  ppr :: StringLiteral -> SDoc
ppr StringLiteral
sl = SourceText -> SDoc -> SDoc
pprWithSourceText (StringLiteral -> SourceText
sl_st StringLiteral
sl) (FastString -> SDoc
ftext (FastString -> SDoc) -> FastString -> SDoc
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
sl_fs StringLiteral
sl)

instance Binary StringLiteral where
  put_ :: BinHandle -> StringLiteral -> IO ()
put_ BinHandle
bh (StringLiteral SourceText
st FastString
fs Maybe RealSrcSpan
_) = do
            BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
st
            BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO StringLiteral
get BinHandle
bh = do
            SourceText
st <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
            FastString
fs <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
            StringLiteral -> IO StringLiteral
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText -> FastString -> Maybe RealSrcSpan -> StringLiteral
StringLiteral SourceText
st FastString
fs Maybe RealSrcSpan
forall a. Maybe a
Nothing)