{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1998

-}

{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-- | Core literals
module GHC.Types.Literal
        (
        -- * Main data type
          Literal(..)           -- Exported to ParseIface
        , LitNumType(..)

        -- ** Creating Literals
        , mkLitInt, mkLitIntWrap, mkLitIntWrapC, mkLitIntUnchecked
        , mkLitWord, mkLitWordWrap, mkLitWordWrapC
        , mkLitInt8, mkLitInt8Wrap
        , mkLitWord8, mkLitWord8Wrap
        , mkLitInt16, mkLitInt16Wrap
        , mkLitWord16, mkLitWord16Wrap
        , mkLitInt32, mkLitInt32Wrap
        , mkLitWord32, mkLitWord32Wrap
        , mkLitInt64, mkLitInt64Wrap
        , mkLitWord64, mkLitWord64Wrap
        , mkLitFloat, mkLitDouble
        , mkLitChar, mkLitString
        , mkLitInteger, mkLitNatural
        , mkLitNumber, mkLitNumberWrap

        -- ** Operations on Literals
        , literalType
        , absentLiteralOf
        , pprLiteral
        , litNumIsSigned
        , litNumCheckRange
        , litNumWrap
        , litNumCoerce
        , litNumNarrow
        , litNumBitSize
        , isMinBound
        , isMaxBound

        -- ** Predicates on Literals and their contents
        , litIsDupable, litIsTrivial, litIsLifted
        , inCharRange
        , isZeroLit, isOneLit
        , litFitsInChar
        , litValue, mapLitValue
        , isLitValue_maybe

        -- ** Coercions
        , narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit
        , narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit
        , convertToIntLit, convertToWordLit
        , charToIntLit, intToCharLit
        , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit
        , nullAddrLit, floatToDoubleLit, doubleToFloatLit
        , rubbishLit, isRubbishLit
        ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Builtin.Types.Prim
import {-# SOURCE #-} GHC.Builtin.Types
import GHC.Builtin.Names
import GHC.Core.Type
import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Types.Basic
import GHC.Utils.Binary
import GHC.Settings.Constants
import GHC.Platform
import GHC.Types.Unique.FM
import GHC.Utils.Misc
import GHC.Utils.Panic

import Data.ByteString (ByteString)
import Data.Int
import Data.Word
import Data.Char
import Data.Data ( Data )
import GHC.Exts
import Numeric ( fromRat )

{-
************************************************************************
*                                                                      *
\subsection{Literals}
*                                                                      *
************************************************************************
-}

-- | So-called 'Literal's are one of:
--
-- * An unboxed numeric literal or floating-point literal which is presumed
--   to be surrounded by appropriate constructors (@Int#@, etc.), so that
--   the overall thing makes sense.
--
--   We maintain the invariant that the 'Integer' in the 'LitNumber'
--   constructor is actually in the (possibly target-dependent) range.
--   The mkLit{Int,Word}*Wrap smart constructors ensure this by applying
--   the target machine's wrapping semantics. Use these in situations
--   where you know the wrapping semantics are correct.
--
-- * The literal derived from the label mentioned in a \"foreign label\"
--   declaration ('LitLabel')
--
-- * A 'LitRubbish' to be used in place of values of 'UnliftedRep'
--   (i.e. 'MutVar#') when the value is never used.
--
-- * A character
-- * A string
-- * The NULL pointer
--
data Literal
  = LitChar    Char             -- ^ @Char#@ - at least 31 bits. Create with
                                -- 'mkLitChar'

  | LitNumber !LitNumType !Integer
                                -- ^ Any numeric literal that can be
                                -- internally represented with an Integer.

  | LitString !ByteString       -- ^ A string-literal: stored and emitted
                                -- UTF-8 encoded, we'll arrange to decode it
                                -- at runtime.  Also emitted with a @\'\\0\'@
                                -- terminator. Create with 'mkLitString'

  | LitNullAddr                 -- ^ The @NULL@ pointer, the only pointer value
                                -- that can be represented as a Literal. Create
                                -- with 'nullAddrLit'

  | LitRubbish Bool             -- ^ A nonsense value; always boxed, but
                                --      True <=> lifted, False <=> unlifted
                                -- Used when a binding is absent.
                                -- See Note [Rubbish literals]

  | LitFloat   Rational         -- ^ @Float#@. Create with 'mkLitFloat'
  | LitDouble  Rational         -- ^ @Double#@. Create with 'mkLitDouble'

  | LitLabel   FastString (Maybe Int) FunctionOrData
                                -- ^ A label literal. Parameters:
                                --
                                -- 1) The name of the symbol mentioned in the
                                --    declaration
                                --
                                -- 2) The size (in bytes) of the arguments
                                --    the label expects. Only applicable with
                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                --    be appended to label name when emitting
                                --    assembly.
                                --
                                -- 3) Flag indicating whether the symbol
                                --    references a function or a data
  deriving Typeable Literal
Literal -> DataType
Literal -> Constr
(forall b. Data b => b -> b) -> Literal -> Literal
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) -> Literal -> u
forall u. (forall d. Data d => d -> u) -> Literal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
$cgmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
dataTypeOf :: Literal -> DataType
$cdataTypeOf :: Literal -> DataType
toConstr :: Literal -> Constr
$ctoConstr :: Literal -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
Data

-- | Numeric literal type
data LitNumType
  = LitNumInteger -- ^ @Integer@ (see Note [BigNum literals])
  | LitNumNatural -- ^ @Natural@ (see Note [BigNum literals])
  | LitNumInt     -- ^ @Int#@ - according to target machine
  | LitNumInt8    -- ^ @Int8#@ - exactly 8 bits
  | LitNumInt16   -- ^ @Int16#@ - exactly 16 bits
  | LitNumInt32   -- ^ @Int32#@ - exactly 32 bits
  | LitNumInt64   -- ^ @Int64#@ - exactly 64 bits
  | LitNumWord    -- ^ @Word#@ - according to target machine
  | LitNumWord8   -- ^ @Word8#@ - exactly 8 bits
  | LitNumWord16  -- ^ @Word16#@ - exactly 16 bits
  | LitNumWord32  -- ^ @Word32#@ - exactly 32 bits
  | LitNumWord64  -- ^ @Word64#@ - exactly 64 bits
  deriving (Typeable LitNumType
LitNumType -> DataType
LitNumType -> Constr
(forall b. Data b => b -> b) -> LitNumType -> LitNumType
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) -> LitNumType -> u
forall u. (forall d. Data d => d -> u) -> LitNumType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LitNumType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LitNumType -> c LitNumType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LitNumType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LitNumType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LitNumType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LitNumType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LitNumType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LitNumType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
gmapT :: (forall b. Data b => b -> b) -> LitNumType -> LitNumType
$cgmapT :: (forall b. Data b => b -> b) -> LitNumType -> LitNumType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LitNumType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LitNumType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LitNumType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LitNumType)
dataTypeOf :: LitNumType -> DataType
$cdataTypeOf :: LitNumType -> DataType
toConstr :: LitNumType -> Constr
$ctoConstr :: LitNumType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LitNumType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LitNumType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LitNumType -> c LitNumType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LitNumType -> c LitNumType
Data,Int -> LitNumType
LitNumType -> Int
LitNumType -> [LitNumType]
LitNumType -> LitNumType
LitNumType -> LitNumType -> [LitNumType]
LitNumType -> LitNumType -> LitNumType -> [LitNumType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LitNumType -> LitNumType -> LitNumType -> [LitNumType]
$cenumFromThenTo :: LitNumType -> LitNumType -> LitNumType -> [LitNumType]
enumFromTo :: LitNumType -> LitNumType -> [LitNumType]
$cenumFromTo :: LitNumType -> LitNumType -> [LitNumType]
enumFromThen :: LitNumType -> LitNumType -> [LitNumType]
$cenumFromThen :: LitNumType -> LitNumType -> [LitNumType]
enumFrom :: LitNumType -> [LitNumType]
$cenumFrom :: LitNumType -> [LitNumType]
fromEnum :: LitNumType -> Int
$cfromEnum :: LitNumType -> Int
toEnum :: Int -> LitNumType
$ctoEnum :: Int -> LitNumType
pred :: LitNumType -> LitNumType
$cpred :: LitNumType -> LitNumType
succ :: LitNumType -> LitNumType
$csucc :: LitNumType -> LitNumType
Enum,LitNumType -> LitNumType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LitNumType -> LitNumType -> Bool
$c/= :: LitNumType -> LitNumType -> Bool
== :: LitNumType -> LitNumType -> Bool
$c== :: LitNumType -> LitNumType -> Bool
Eq,Eq LitNumType
LitNumType -> LitNumType -> Bool
LitNumType -> LitNumType -> Ordering
LitNumType -> LitNumType -> LitNumType
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
min :: LitNumType -> LitNumType -> LitNumType
$cmin :: LitNumType -> LitNumType -> LitNumType
max :: LitNumType -> LitNumType -> LitNumType
$cmax :: LitNumType -> LitNumType -> LitNumType
>= :: LitNumType -> LitNumType -> Bool
$c>= :: LitNumType -> LitNumType -> Bool
> :: LitNumType -> LitNumType -> Bool
$c> :: LitNumType -> LitNumType -> Bool
<= :: LitNumType -> LitNumType -> Bool
$c<= :: LitNumType -> LitNumType -> Bool
< :: LitNumType -> LitNumType -> Bool
$c< :: LitNumType -> LitNumType -> Bool
compare :: LitNumType -> LitNumType -> Ordering
$ccompare :: LitNumType -> LitNumType -> Ordering
Ord)

-- | Indicate if a numeric literal type supports negative numbers
litNumIsSigned :: LitNumType -> Bool
litNumIsSigned :: LitNumType -> Bool
litNumIsSigned LitNumType
nt = case LitNumType
nt of
  LitNumType
LitNumInteger -> Bool
True
  LitNumType
LitNumNatural -> Bool
False
  LitNumType
LitNumInt     -> Bool
True
  LitNumType
LitNumInt8    -> Bool
True
  LitNumType
LitNumInt16   -> Bool
True
  LitNumType
LitNumInt32   -> Bool
True
  LitNumType
LitNumInt64   -> Bool
True
  LitNumType
LitNumWord    -> Bool
False
  LitNumType
LitNumWord8   -> Bool
False
  LitNumType
LitNumWord16  -> Bool
False
  LitNumType
LitNumWord32  -> Bool
False
  LitNumType
LitNumWord64  -> Bool
False

-- | Number of bits
litNumBitSize :: Platform -> LitNumType -> Maybe Word
litNumBitSize :: Platform -> LitNumType -> Maybe Word
litNumBitSize Platform
platform LitNumType
nt = case LitNumType
nt of
  LitNumType
LitNumInteger -> forall a. Maybe a
Nothing
  LitNumType
LitNumNatural -> forall a. Maybe a
Nothing
  LitNumType
LitNumInt     -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> Int
platformWordSizeInBits Platform
platform))
  LitNumType
LitNumInt8    -> forall a. a -> Maybe a
Just Word
8
  LitNumType
LitNumInt16   -> forall a. a -> Maybe a
Just Word
16
  LitNumType
LitNumInt32   -> forall a. a -> Maybe a
Just Word
32
  LitNumType
LitNumInt64   -> forall a. a -> Maybe a
Just Word
64
  LitNumType
LitNumWord    -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> Int
platformWordSizeInBits Platform
platform))
  LitNumType
LitNumWord8   -> forall a. a -> Maybe a
Just Word
8
  LitNumType
LitNumWord16  -> forall a. a -> Maybe a
Just Word
16
  LitNumType
LitNumWord32  -> forall a. a -> Maybe a
Just Word
32
  LitNumType
LitNumWord64  -> forall a. a -> Maybe a
Just Word
64

instance Binary LitNumType where
   put_ :: BinHandle -> LitNumType -> IO ()
put_ BinHandle
bh LitNumType
numTyp = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum LitNumType
numTyp))
   get :: BinHandle -> IO LitNumType
get BinHandle
bh = do
      Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
h))

{-
Note [BigNum literals]
~~~~~~~~~~~~~~~~~~~~~~

GHC supports 2 kinds of arbitrary precision integers (a.k.a BigNum):

   * Natural: natural represented as a Word# or as a BigNat

   * Integer: integer represented a an Int# or as a BigNat (Integer's
   constructors indicate the sign)

BigNum literal instances are removed from Core during the CorePrep phase. They
are replaced with expression to build them at runtime from machine literals
(Word#, Int#, etc.) or from a list of Word#s.

Note [String literals]
~~~~~~~~~~~~~~~~~~~~~~

String literals are UTF-8 encoded and stored into ByteStrings in the following
ASTs: Haskell, Core, Stg, Cmm. TH can also emit ByteString based string literals
with the BytesPrimL constructor (see #14741).

It wasn't true before as [Word8] was used in Cmm AST and in TH which was quite
bad for performance with large strings (see #16198 and #14741).

To include string literals into output objects, the assembler code generator has
to embed the UTF-8 encoded binary blob. See Note [Embedding large binary blobs]
for more details.

-}

instance Binary Literal where
    put_ :: BinHandle -> Literal -> IO ()
put_ BinHandle
bh (LitChar Char
aa)     = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Char
aa
    put_ BinHandle
bh (LitString ByteString
ab)   = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
ab
    put_ BinHandle
bh (Literal
LitNullAddr)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    put_ BinHandle
bh (LitFloat Rational
ah)    = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Rational
ah
    put_ BinHandle
bh (LitDouble Rational
ai)   = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Rational
ai
    put_ BinHandle
bh (LitLabel FastString
aj Maybe Int
mb FunctionOrData
fod)
        = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
             forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
aj
             forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Int
mb
             forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FunctionOrData
fod
    put_ BinHandle
bh (LitNumber LitNumType
nt Integer
i)
        = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
             forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LitNumType
nt
             forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
    put_ BinHandle
bh (LitRubbish Bool
b) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7; forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
    get :: BinHandle -> IO Literal
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do
                    Char
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Literal
LitChar Char
aa)
              Word8
1 -> do
                    ByteString
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Literal
LitString ByteString
ab)
              Word8
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Literal
LitNullAddr)
              Word8
3 -> do
                    Rational
ah <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Literal
LitFloat Rational
ah)
              Word8
4 -> do
                    Rational
ai <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Literal
LitDouble Rational
ai)
              Word8
5 -> do
                    FastString
aj <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Maybe Int
mb <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    FunctionOrData
fod <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> Maybe Int -> FunctionOrData -> Literal
LitLabel FastString
aj Maybe Int
mb FunctionOrData
fod)
              Word8
6 -> do
                    LitNumType
nt <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Integer
i  <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (LitNumType -> Integer -> Literal
LitNumber LitNumType
nt Integer
i)
              Word8
_ -> do
                    Bool
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Literal
LitRubbish Bool
b)

instance Outputable Literal where
    ppr :: Literal -> SDoc
ppr = (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral forall a. a -> a
id

instance Eq Literal where
    Literal
a == :: Literal -> Literal -> Bool
== Literal
b = forall a. Ord a => a -> a -> Ordering
compare Literal
a Literal
b forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in
-- 'GHC.Data.TrieMap.CoreMap'.
instance Ord Literal where
    compare :: Literal -> Literal -> Ordering
compare = Literal -> Literal -> Ordering
cmpLit

{-
        Construction
        ~~~~~~~~~~~~
-}

{- Note [Word/Int underflow/overflow]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
According to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and
unsigned integral types): "All arithmetic is performed modulo 2^n, where n is
the number of bits in the type."

GHC stores Word# and Int# constant values as Integer. Core optimizations such
as constant folding must ensure that the Integer value remains in the valid
target Word/Int range (see #13172). The following functions are used to
ensure this.

Note that we *don't* warn the user about overflow. It's not done at runtime
either, and compilation of completely harmless things like
   ((124076834 :: Word32) + (2147483647 :: Word32))
doesn't yield a warning. Instead we simply squash the value into the *target*
Int/Word range.
-}

-- | Make a literal number using wrapping semantics if the value is out of
-- bound.
mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
nt Integer
i = case LitNumType
nt of
  LitNumType
LitNumInt -> case Platform -> PlatformWordSize
platformWordSize Platform
platform of
    PlatformWordSize
PW4 -> forall a. (Integral a, Num a) => Literal
wrap @Int32
    PlatformWordSize
PW8 -> forall a. (Integral a, Num a) => Literal
wrap @Int64
  LitNumType
LitNumWord -> case Platform -> PlatformWordSize
platformWordSize Platform
platform of
    PlatformWordSize
PW4 -> forall a. (Integral a, Num a) => Literal
wrap @Word32
    PlatformWordSize
PW8 -> forall a. (Integral a, Num a) => Literal
wrap @Word64
  LitNumType
LitNumInt8    -> forall a. (Integral a, Num a) => Literal
wrap @Int8
  LitNumType
LitNumInt16   -> forall a. (Integral a, Num a) => Literal
wrap @Int16
  LitNumType
LitNumInt32   -> forall a. (Integral a, Num a) => Literal
wrap @Int32
  LitNumType
LitNumInt64   -> forall a. (Integral a, Num a) => Literal
wrap @Int64
  LitNumType
LitNumWord8   -> forall a. (Integral a, Num a) => Literal
wrap @Word8
  LitNumType
LitNumWord16  -> forall a. (Integral a, Num a) => Literal
wrap @Word16
  LitNumType
LitNumWord32  -> forall a. (Integral a, Num a) => Literal
wrap @Word32
  LitNumType
LitNumWord64  -> forall a. (Integral a, Num a) => Literal
wrap @Word64
  LitNumType
LitNumInteger -> LitNumType -> Integer -> Literal
LitNumber LitNumType
nt Integer
i
  LitNumType
LitNumNatural
    | Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0     -> forall a. String -> a
panic String
"mkLitNumberWrap: trying to create a negative Natural"
    | Bool
otherwise -> LitNumType -> Integer -> Literal
LitNumber LitNumType
nt Integer
i
  where
    wrap :: forall a. (Integral a, Num a) => Literal
    wrap :: forall a. (Integral a, Num a) => Literal
wrap = LitNumType -> Integer -> Literal
LitNumber LitNumType
nt (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: a))

-- | Wrap a literal number according to its type using wrapping semantics.
litNumWrap :: Platform -> Literal -> Literal
litNumWrap :: Platform -> Literal -> Literal
litNumWrap Platform
platform (LitNumber LitNumType
nt Integer
i) = Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
nt Integer
i
litNumWrap Platform
_        Literal
l                = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumWrap" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

-- | Coerce a literal number into another using wrapping semantics.
litNumCoerce :: LitNumType -> Platform -> Literal -> Literal
litNumCoerce :: LitNumType -> Platform -> Literal -> Literal
litNumCoerce LitNumType
pt Platform
platform (LitNumber LitNumType
_nt Integer
i) = Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
pt Integer
i
litNumCoerce LitNumType
_  Platform
_        Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumWrapCoerce: not a number" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

-- | Narrow a literal number by converting it into another number type and then
-- converting it back to its original type.
litNumNarrow :: LitNumType -> Platform -> Literal -> Literal
litNumNarrow :: LitNumType -> Platform -> Literal -> Literal
litNumNarrow LitNumType
pt Platform
platform (LitNumber LitNumType
nt Integer
i)
   = case Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
pt Integer
i of
      LitNumber LitNumType
_ Integer
j -> Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
nt Integer
j
      Literal
l             -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumNarrow: got invalid literal" (forall a. Outputable a => a -> SDoc
ppr Literal
l)
litNumNarrow LitNumType
_ Platform
_ Literal
l = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumNarrow: invalid literal" (forall a. Outputable a => a -> SDoc
ppr Literal
l)


-- | Check that a given number is in the range of a numeric literal
litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool
litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool
litNumCheckRange Platform
platform LitNumType
nt Integer
i = case LitNumType
nt of
     LitNumType
LitNumInt     -> Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
i
     LitNumType
LitNumWord    -> Platform -> Integer -> Bool
platformInWordRange Platform
platform Integer
i
     LitNumType
LitNumInt8    -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int8 Integer
i
     LitNumType
LitNumInt16   -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int16 Integer
i
     LitNumType
LitNumInt32   -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int32 Integer
i
     LitNumType
LitNumInt64   -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int64 Integer
i
     LitNumType
LitNumWord8   -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word8 Integer
i
     LitNumType
LitNumWord16  -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word16 Integer
i
     LitNumType
LitNumWord32  -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word32 Integer
i
     LitNumType
LitNumWord64  -> forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word64 Integer
i
     LitNumType
LitNumNatural -> Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
0
     LitNumType
LitNumInteger -> Bool
True

-- | Create a numeric 'Literal' of the given type
mkLitNumber :: Platform -> LitNumType -> Integer -> Literal
mkLitNumber :: Platform -> LitNumType -> Integer -> Literal
mkLitNumber Platform
platform LitNumType
nt Integer
i =
  ASSERT2(litNumCheckRange platform nt i, integer i)
  (LitNumType -> Integer -> Literal
LitNumber LitNumType
nt Integer
i)

-- | Creates a 'Literal' of type @Int#@
mkLitInt :: Platform -> Integer -> Literal
mkLitInt :: Platform -> Integer -> Literal
mkLitInt Platform
platform Integer
x = ASSERT2( platformInIntRange platform x,  integer x )
                       (Integer -> Literal
mkLitIntUnchecked Integer
x)

-- | Creates a 'Literal' of type @Int#@.
--   If the argument is out of the (target-dependent) range, it is wrapped.
--   See Note [Word/Int underflow/overflow]
mkLitIntWrap :: Platform -> Integer -> Literal
mkLitIntWrap :: Platform -> Integer -> Literal
mkLitIntWrap Platform
platform Integer
i = Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
LitNumInt Integer
i

-- | Creates a 'Literal' of type @Int#@ without checking its range.
mkLitIntUnchecked :: Integer -> Literal
mkLitIntUnchecked :: Integer -> Literal
mkLitIntUnchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumInt Integer
i

-- | Creates a 'Literal' of type @Int#@, as well as a 'Bool'ean flag indicating
--   overflow. That is, if the argument is out of the (target-dependent) range
--   the argument is wrapped and the overflow flag will be set.
--   See Note [Word/Int underflow/overflow]
mkLitIntWrapC :: Platform -> Integer -> (Literal, Bool)
mkLitIntWrapC :: Platform -> Integer -> (Literal, Bool)
mkLitIntWrapC Platform
platform Integer
i = (Literal
n, Integer
i forall a. Eq a => a -> a -> Bool
/= Integer
i')
  where
    n :: Literal
n@(LitNumber LitNumType
_ Integer
i') = Platform -> Integer -> Literal
mkLitIntWrap Platform
platform Integer
i

-- | Creates a 'Literal' of type @Word#@
mkLitWord :: Platform -> Integer -> Literal
mkLitWord :: Platform -> Integer -> Literal
mkLitWord Platform
platform Integer
x = ASSERT2( platformInWordRange platform x, integer x )
                        (Integer -> Literal
mkLitWordUnchecked Integer
x)

-- | Creates a 'Literal' of type @Word#@.
--   If the argument is out of the (target-dependent) range, it is wrapped.
--   See Note [Word/Int underflow/overflow]
mkLitWordWrap :: Platform -> Integer -> Literal
mkLitWordWrap :: Platform -> Integer -> Literal
mkLitWordWrap Platform
platform Integer
i = Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
LitNumWord Integer
i

-- | Creates a 'Literal' of type @Word#@ without checking its range.
mkLitWordUnchecked :: Integer -> Literal
mkLitWordUnchecked :: Integer -> Literal
mkLitWordUnchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumWord Integer
i

-- | Creates a 'Literal' of type @Word#@, as well as a 'Bool'ean flag indicating
--   carry. That is, if the argument is out of the (target-dependent) range
--   the argument is wrapped and the carry flag will be set.
--   See Note [Word/Int underflow/overflow]
mkLitWordWrapC :: Platform -> Integer -> (Literal, Bool)
mkLitWordWrapC :: Platform -> Integer -> (Literal, Bool)
mkLitWordWrapC Platform
platform Integer
i = (Literal
n, Integer
i forall a. Eq a => a -> a -> Bool
/= Integer
i')
  where
    n :: Literal
n@(LitNumber LitNumType
_ Integer
i') = Platform -> Integer -> Literal
mkLitWordWrap Platform
platform Integer
i

-- | Creates a 'Literal' of type @Int8#@
mkLitInt8 :: Integer -> Literal
mkLitInt8 :: Integer -> Literal
mkLitInt8  Integer
x = ASSERT2( inBoundedRange @Int8 x, integer x ) (mkLitInt8Unchecked x)

-- | Creates a 'Literal' of type @Int8#@.
--   If the argument is out of the range, it is wrapped.
mkLitInt8Wrap :: Integer -> Literal
mkLitInt8Wrap :: Integer -> Literal
mkLitInt8Wrap Integer
i = Integer -> Literal
mkLitInt8Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int8))

-- | Creates a 'Literal' of type @Int8#@ without checking its range.
mkLitInt8Unchecked :: Integer -> Literal
mkLitInt8Unchecked :: Integer -> Literal
mkLitInt8Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumInt8 Integer
i

-- | Creates a 'Literal' of type @Word8#@
mkLitWord8 :: Integer -> Literal
mkLitWord8 :: Integer -> Literal
mkLitWord8 Integer
x = ASSERT2( inBoundedRange @Word8 x, integer x ) (mkLitWord8Unchecked x)

-- | Creates a 'Literal' of type @Word8#@.
--   If the argument is out of the range, it is wrapped.
mkLitWord8Wrap :: Integer -> Literal
mkLitWord8Wrap :: Integer -> Literal
mkLitWord8Wrap Integer
i = Integer -> Literal
mkLitWord8Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word8))

-- | Creates a 'Literal' of type @Word8#@ without checking its range.
mkLitWord8Unchecked :: Integer -> Literal
mkLitWord8Unchecked :: Integer -> Literal
mkLitWord8Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumWord8 Integer
i

-- | Creates a 'Literal' of type @Int16#@
mkLitInt16 :: Integer -> Literal
mkLitInt16 :: Integer -> Literal
mkLitInt16  Integer
x = ASSERT2( inBoundedRange @Int16 x, integer x ) (mkLitInt16Unchecked x)

-- | Creates a 'Literal' of type @Int16#@.
--   If the argument is out of the range, it is wrapped.
mkLitInt16Wrap :: Integer -> Literal
mkLitInt16Wrap :: Integer -> Literal
mkLitInt16Wrap Integer
i = Integer -> Literal
mkLitInt16Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int16))

-- | Creates a 'Literal' of type @Int16#@ without checking its range.
mkLitInt16Unchecked :: Integer -> Literal
mkLitInt16Unchecked :: Integer -> Literal
mkLitInt16Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumInt16 Integer
i

-- | Creates a 'Literal' of type @Word16#@
mkLitWord16 :: Integer -> Literal
mkLitWord16 :: Integer -> Literal
mkLitWord16 Integer
x = ASSERT2( inBoundedRange @Word16 x, integer x ) (mkLitWord16Unchecked x)

-- | Creates a 'Literal' of type @Word16#@.
--   If the argument is out of the range, it is wrapped.
mkLitWord16Wrap :: Integer -> Literal
mkLitWord16Wrap :: Integer -> Literal
mkLitWord16Wrap Integer
i = Integer -> Literal
mkLitWord16Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word16))

-- | Creates a 'Literal' of type @Word16#@ without checking its range.
mkLitWord16Unchecked :: Integer -> Literal
mkLitWord16Unchecked :: Integer -> Literal
mkLitWord16Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumWord16 Integer
i

-- | Creates a 'Literal' of type @Int32#@
mkLitInt32 :: Integer -> Literal
mkLitInt32 :: Integer -> Literal
mkLitInt32  Integer
x = ASSERT2( inBoundedRange @Int32 x, integer x ) (mkLitInt32Unchecked x)

-- | Creates a 'Literal' of type @Int32#@.
--   If the argument is out of the range, it is wrapped.
mkLitInt32Wrap :: Integer -> Literal
mkLitInt32Wrap :: Integer -> Literal
mkLitInt32Wrap Integer
i = Integer -> Literal
mkLitInt32Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int32))

-- | Creates a 'Literal' of type @Int32#@ without checking its range.
mkLitInt32Unchecked :: Integer -> Literal
mkLitInt32Unchecked :: Integer -> Literal
mkLitInt32Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumInt32 Integer
i

-- | Creates a 'Literal' of type @Word32#@
mkLitWord32 :: Integer -> Literal
mkLitWord32 :: Integer -> Literal
mkLitWord32 Integer
x = ASSERT2( inBoundedRange @Word32 x, integer x ) (mkLitWord32Unchecked x)

-- | Creates a 'Literal' of type @Word32#@.
--   If the argument is out of the range, it is wrapped.
mkLitWord32Wrap :: Integer -> Literal
mkLitWord32Wrap :: Integer -> Literal
mkLitWord32Wrap Integer
i = Integer -> Literal
mkLitWord32Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word32))

-- | Creates a 'Literal' of type @Word32#@ without checking its range.
mkLitWord32Unchecked :: Integer -> Literal
mkLitWord32Unchecked :: Integer -> Literal
mkLitWord32Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumWord32 Integer
i

-- | Creates a 'Literal' of type @Int64#@
mkLitInt64 :: Integer -> Literal
mkLitInt64 :: Integer -> Literal
mkLitInt64  Integer
x = ASSERT2( inBoundedRange @Int64 x, integer x ) (mkLitInt64Unchecked x)

-- | Creates a 'Literal' of type @Int64#@.
--   If the argument is out of the range, it is wrapped.
mkLitInt64Wrap :: Integer -> Literal
mkLitInt64Wrap :: Integer -> Literal
mkLitInt64Wrap Integer
i = Integer -> Literal
mkLitInt64Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int64))

-- | Creates a 'Literal' of type @Int64#@ without checking its range.
mkLitInt64Unchecked :: Integer -> Literal
mkLitInt64Unchecked :: Integer -> Literal
mkLitInt64Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumInt64 Integer
i

-- | Creates a 'Literal' of type @Word64#@
mkLitWord64 :: Integer -> Literal
mkLitWord64 :: Integer -> Literal
mkLitWord64 Integer
x = ASSERT2( inBoundedRange @Word64 x, integer x ) (mkLitWord64Unchecked x)

-- | Creates a 'Literal' of type @Word64#@.
--   If the argument is out of the range, it is wrapped.
mkLitWord64Wrap :: Integer -> Literal
mkLitWord64Wrap :: Integer -> Literal
mkLitWord64Wrap Integer
i = Integer -> Literal
mkLitWord64Unchecked (forall a. Integral a => a -> Integer
toInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word64))

-- | Creates a 'Literal' of type @Word64#@ without checking its range.
mkLitWord64Unchecked :: Integer -> Literal
mkLitWord64Unchecked :: Integer -> Literal
mkLitWord64Unchecked Integer
i = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumWord64 Integer
i

-- | Creates a 'Literal' of type @Float#@
mkLitFloat :: Rational -> Literal
mkLitFloat :: Rational -> Literal
mkLitFloat = Rational -> Literal
LitFloat

-- | Creates a 'Literal' of type @Double#@
mkLitDouble :: Rational -> Literal
mkLitDouble :: Rational -> Literal
mkLitDouble = Rational -> Literal
LitDouble

-- | Creates a 'Literal' of type @Char#@
mkLitChar :: Char -> Literal
mkLitChar :: Char -> Literal
mkLitChar = Char -> Literal
LitChar

-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
mkLitString :: String -> Literal
-- stored UTF-8 encoded
mkLitString :: String -> Literal
mkLitString String
s = ByteString -> Literal
LitString (FastString -> ByteString
bytesFS forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString String
s)

mkLitInteger :: Integer -> Literal
mkLitInteger :: Integer -> Literal
mkLitInteger Integer
x = LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumInteger Integer
x

mkLitNatural :: Integer -> Literal
mkLitNatural :: Integer -> Literal
mkLitNatural Integer
x = ASSERT2( inNaturalRange x,  integer x )
                    (LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumNatural Integer
x)

inNaturalRange :: Integer -> Bool
inNaturalRange :: Integer -> Bool
inNaturalRange Integer
x = Integer
x forall a. Ord a => a -> a -> Bool
>= Integer
0

inBoundedRange :: forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange :: forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange Integer
x  = Integer
x forall a. Ord a => a -> a -> Bool
>= forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: a) Bool -> Bool -> Bool
&&
                    Integer
x forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: a)

isMinBound :: Platform -> Literal -> Bool
isMinBound :: Platform -> Literal -> Bool
isMinBound Platform
_        (LitChar Char
c)        = Char
c forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound
isMinBound Platform
platform (LitNumber LitNumType
nt Integer
i)   = case LitNumType
nt of
   LitNumType
LitNumInt     -> Integer
i forall a. Eq a => a -> a -> Bool
== Platform -> Integer
platformMinInt Platform
platform
   LitNumType
LitNumInt8    -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int8)
   LitNumType
LitNumInt16   -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int16)
   LitNumType
LitNumInt32   -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int32)
   LitNumType
LitNumInt64   -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int64)
   LitNumType
LitNumWord    -> Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0
   LitNumType
LitNumWord8   -> Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0
   LitNumType
LitNumWord16  -> Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0
   LitNumType
LitNumWord32  -> Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0
   LitNumType
LitNumWord64  -> Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0
   LitNumType
LitNumNatural -> Integer
i forall a. Eq a => a -> a -> Bool
== Integer
0
   LitNumType
LitNumInteger -> Bool
False
isMinBound Platform
_        Literal
_                  = Bool
False

isMaxBound :: Platform -> Literal -> Bool
isMaxBound :: Platform -> Literal -> Bool
isMaxBound Platform
_        (LitChar Char
c)        = Char
c forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound
isMaxBound Platform
platform (LitNumber LitNumType
nt Integer
i)   = case LitNumType
nt of
   LitNumType
LitNumInt     -> Integer
i forall a. Eq a => a -> a -> Bool
== Platform -> Integer
platformMaxInt Platform
platform
   LitNumType
LitNumInt8    -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int8)
   LitNumType
LitNumInt16   -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int16)
   LitNumType
LitNumInt32   -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int32)
   LitNumType
LitNumInt64   -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int64)
   LitNumType
LitNumWord    -> Integer
i forall a. Eq a => a -> a -> Bool
== Platform -> Integer
platformMaxWord Platform
platform
   LitNumType
LitNumWord8   -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word8)
   LitNumType
LitNumWord16  -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word16)
   LitNumType
LitNumWord32  -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word32)
   LitNumType
LitNumWord64  -> Integer
i forall a. Eq a => a -> a -> Bool
== forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word64)
   LitNumType
LitNumNatural -> Bool
False
   LitNumType
LitNumInteger -> Bool
False
isMaxBound Platform
_        Literal
_                  = Bool
False

inCharRange :: Char -> Bool
inCharRange :: Char -> Bool
inCharRange Char
c =  Char
c forall a. Ord a => a -> a -> Bool
>= Char
'\0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Int -> Char
chr Int
tARGET_MAX_CHAR

-- | Tests whether the literal represents a zero of whatever type it is
isZeroLit :: Literal -> Bool
isZeroLit :: Literal -> Bool
isZeroLit (LitNumber LitNumType
_ Integer
0) = Bool
True
isZeroLit (LitFloat  Rational
0)   = Bool
True
isZeroLit (LitDouble Rational
0)   = Bool
True
isZeroLit Literal
_               = Bool
False

-- | Tests whether the literal represents a one of whatever type it is
isOneLit :: Literal -> Bool
isOneLit :: Literal -> Bool
isOneLit (LitNumber LitNumType
_ Integer
1) = Bool
True
isOneLit (LitFloat  Rational
1)   = Bool
True
isOneLit (LitDouble Rational
1)   = Bool
True
isOneLit Literal
_               = Bool
False

-- | Returns the 'Integer' contained in the 'Literal', for when that makes
-- sense, i.e. for 'Char', 'Int', 'Word', 'LitInteger' and 'LitNatural'.
litValue  :: Literal -> Integer
litValue :: Literal -> Integer
litValue Literal
l = case Literal -> Maybe Integer
isLitValue_maybe Literal
l of
   Just Integer
x  -> Integer
x
   Maybe Integer
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litValue" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

-- | Returns the 'Integer' contained in the 'Literal', for when that makes
-- sense, i.e. for 'Char' and numbers.
isLitValue_maybe  :: Literal -> Maybe Integer
isLitValue_maybe :: Literal -> Maybe Integer
isLitValue_maybe (LitChar   Char
c)     = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c
isLitValue_maybe (LitNumber LitNumType
_ Integer
i)   = forall a. a -> Maybe a
Just Integer
i
isLitValue_maybe Literal
_                 = forall a. Maybe a
Nothing

-- | Apply a function to the 'Integer' contained in the 'Literal', for when that
-- makes sense, e.g. for 'Char' and numbers.
-- For fixed-size integral literals, the result will be wrapped in accordance
-- with the semantics of the target type.
-- See Note [Word/Int underflow/overflow]
mapLitValue  :: Platform -> (Integer -> Integer) -> Literal -> Literal
mapLitValue :: Platform -> (Integer -> Integer) -> Literal -> Literal
mapLitValue Platform
_        Integer -> Integer
f (LitChar   Char
c)      = Char -> Literal
mkLitChar (Char -> Char
fchar Char
c)
   where fchar :: Char -> Char
fchar = Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
mapLitValue Platform
platform Integer -> Integer
f (LitNumber LitNumType
nt Integer
i)   = Platform -> LitNumType -> Integer -> Literal
mkLitNumberWrap Platform
platform LitNumType
nt (Integer -> Integer
f Integer
i)
mapLitValue Platform
_        Integer -> Integer
_ Literal
l                  = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mapLitValue" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

{-
        Coercions
        ~~~~~~~~~
-}

charToIntLit, intToCharLit,
  floatToIntLit, intToFloatLit,
  doubleToIntLit, intToDoubleLit,
  floatToDoubleLit, doubleToFloatLit
  :: Literal -> Literal

-- | Narrow a literal number (unchecked result range)
narrowLit' :: forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' :: forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' LitNumType
nt' (LitNumber LitNumType
_ Integer
i)  = LitNumType -> Integer -> Literal
LitNumber LitNumType
nt' (forall a. Integral a => a -> Integer
toInteger (forall a. Num a => Integer -> a
fromInteger Integer
i :: a))
narrowLit' LitNumType
_   Literal
l                = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"narrowLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit,
  narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit :: Literal -> Literal
narrowInt8Lit :: Literal -> Literal
narrowInt8Lit   = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Int8   LitNumType
LitNumInt8
narrowInt16Lit :: Literal -> Literal
narrowInt16Lit  = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Int16  LitNumType
LitNumInt16
narrowInt32Lit :: Literal -> Literal
narrowInt32Lit  = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Int32  LitNumType
LitNumInt32
narrowInt64Lit :: Literal -> Literal
narrowInt64Lit  = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Int64  LitNumType
LitNumInt64
narrowWord8Lit :: Literal -> Literal
narrowWord8Lit  = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Word8  LitNumType
LitNumWord8
narrowWord16Lit :: Literal -> Literal
narrowWord16Lit = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Word16 LitNumType
LitNumWord16
narrowWord32Lit :: Literal -> Literal
narrowWord32Lit = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Word32 LitNumType
LitNumWord32
narrowWord64Lit :: Literal -> Literal
narrowWord64Lit = forall a. Integral a => LitNumType -> Literal -> Literal
narrowLit' @Word64 LitNumType
LitNumWord64

-- | Extend or narrow a fixed-width literal (e.g. 'Int16#') to a target
-- word-sized literal ('Int#' or 'Word#'). Narrowing can only happen on 32-bit
-- architectures when we convert a 64-bit literal into a 32-bit one.
convertToWordLit, convertToIntLit :: Platform -> Literal -> Literal
convertToWordLit :: Platform -> Literal -> Literal
convertToWordLit Platform
platform (LitNumber LitNumType
_nt Integer
i)  = Platform -> Integer -> Literal
mkLitWordWrap Platform
platform Integer
i
convertToWordLit Platform
_platform Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"convertToWordLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)
convertToIntLit :: Platform -> Literal -> Literal
convertToIntLit  Platform
platform (LitNumber LitNumType
_nt Integer
i)  = Platform -> Integer -> Literal
mkLitIntWrap Platform
platform Integer
i
convertToIntLit  Platform
_platform Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"convertToIntLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

charToIntLit :: Literal -> Literal
charToIntLit (LitChar Char
c)       = Integer -> Literal
mkLitIntUnchecked (forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
c))
charToIntLit Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"charToIntLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)
intToCharLit :: Literal -> Literal
intToCharLit (LitNumber LitNumType
_ Integer
i)   = Char -> Literal
LitChar (Int -> Char
chr (forall a. Num a => Integer -> a
fromInteger Integer
i))
intToCharLit Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"intToCharLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

floatToIntLit :: Literal -> Literal
floatToIntLit (LitFloat Rational
f)      = Integer -> Literal
mkLitIntUnchecked (forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
f)
floatToIntLit Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"floatToIntLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)
intToFloatLit :: Literal -> Literal
intToFloatLit (LitNumber LitNumType
_ Integer
i)   = Rational -> Literal
LitFloat (forall a. Num a => Integer -> a
fromInteger Integer
i)
intToFloatLit Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"intToFloatLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

doubleToIntLit :: Literal -> Literal
doubleToIntLit (LitDouble Rational
f)     = Integer -> Literal
mkLitIntUnchecked (forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
f)
doubleToIntLit Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"doubleToIntLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)
intToDoubleLit :: Literal -> Literal
intToDoubleLit (LitNumber LitNumType
_ Integer
i)   = Rational -> Literal
LitDouble (forall a. Num a => Integer -> a
fromInteger Integer
i)
intToDoubleLit Literal
l                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"intToDoubleLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

floatToDoubleLit :: Literal -> Literal
floatToDoubleLit (LitFloat  Rational
f) = Rational -> Literal
LitDouble Rational
f
floatToDoubleLit Literal
l             = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"floatToDoubleLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)
doubleToFloatLit :: Literal -> Literal
doubleToFloatLit (LitDouble Rational
d) = Rational -> Literal
LitFloat  Rational
d
doubleToFloatLit Literal
l             = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"doubleToFloatLit" (forall a. Outputable a => a -> SDoc
ppr Literal
l)

nullAddrLit :: Literal
nullAddrLit :: Literal
nullAddrLit = Literal
LitNullAddr

-- | A rubbish literal; see Note [Rubbish literals]
rubbishLit :: Bool -> Literal
rubbishLit :: Bool -> Literal
rubbishLit Bool
is_lifted = Bool -> Literal
LitRubbish Bool
is_lifted

isRubbishLit :: Literal -> Bool
isRubbishLit :: Literal -> Bool
isRubbishLit (LitRubbish {}) = Bool
True
isRubbishLit Literal
_               = Bool
False

{-
        Predicates
        ~~~~~~~~~~
-}

-- | True if there is absolutely no penalty to duplicating the literal.
-- False principally of strings.
--
-- "Why?", you say? I'm glad you asked. Well, for one duplicating strings would
-- blow up code sizes. Not only this, it's also unsafe.
--
-- Consider a program that wants to traverse a string. One way it might do this
-- is to first compute the Addr# pointing to the end of the string, and then,
-- starting from the beginning, bump a pointer using eqAddr# to determine the
-- end. For instance,
--
-- @
-- -- Given pointers to the start and end of a string, count how many zeros
-- -- the string contains.
-- countZeros :: Addr# -> Addr# -> -> Int
-- countZeros start end = go start 0
--   where
--     go off n
--       | off `addrEq#` end = n
--       | otherwise         = go (off `plusAddr#` 1) n'
--       where n' | isTrue# (indexInt8OffAddr# off 0# ==# 0#) = n + 1
--                | otherwise                                 = n
-- @
--
-- Consider what happens if we considered strings to be trivial (and therefore
-- duplicable) and emitted a call like @countZeros "hello"# ("hello"#
-- `plusAddr`# 5)@. The beginning and end pointers do not belong to the same
-- string, meaning that an iteration like the above would blow up terribly.
-- This is what happened in #12757.
--
-- Ultimately the solution here is to make primitive strings a bit more
-- structured, ensuring that the compiler can't inline in ways that will break
-- user code. One approach to this is described in #8472.
litIsTrivial :: Literal -> Bool
--      c.f. GHC.Core.Utils.exprIsTrivial
litIsTrivial :: Literal -> Bool
litIsTrivial (LitString ByteString
_)    = Bool
False
litIsTrivial (LitNumber LitNumType
nt Integer
_) = case LitNumType
nt of
  LitNumType
LitNumInteger -> Bool
False
  LitNumType
LitNumNatural -> Bool
False
  LitNumType
LitNumInt     -> Bool
True
  LitNumType
LitNumInt8    -> Bool
True
  LitNumType
LitNumInt16   -> Bool
True
  LitNumType
LitNumInt32   -> Bool
True
  LitNumType
LitNumInt64   -> Bool
True
  LitNumType
LitNumWord    -> Bool
True
  LitNumType
LitNumWord8   -> Bool
True
  LitNumType
LitNumWord16  -> Bool
True
  LitNumType
LitNumWord32  -> Bool
True
  LitNumType
LitNumWord64  -> Bool
True
litIsTrivial Literal
_                  = Bool
True

-- | True if code space does not go bad if we duplicate this literal
litIsDupable :: Platform -> Literal -> Bool
--      c.f. GHC.Core.Utils.exprIsDupable
litIsDupable :: Platform -> Literal -> Bool
litIsDupable Platform
platform Literal
x = case Literal
x of
   (LitNumber LitNumType
nt Integer
i) -> case LitNumType
nt of
      LitNumType
LitNumInteger -> Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
i
      LitNumType
LitNumNatural -> Platform -> Integer -> Bool
platformInWordRange Platform
platform Integer
i
      LitNumType
LitNumInt     -> Bool
True
      LitNumType
LitNumInt8    -> Bool
True
      LitNumType
LitNumInt16   -> Bool
True
      LitNumType
LitNumInt32   -> Bool
True
      LitNumType
LitNumInt64   -> Bool
True
      LitNumType
LitNumWord    -> Bool
True
      LitNumType
LitNumWord8   -> Bool
True
      LitNumType
LitNumWord16  -> Bool
True
      LitNumType
LitNumWord32  -> Bool
True
      LitNumType
LitNumWord64  -> Bool
True
   (LitString ByteString
_) -> Bool
False
   Literal
_             -> Bool
True

litFitsInChar :: Literal -> Bool
litFitsInChar :: Literal -> Bool
litFitsInChar (LitNumber LitNumType
_ Integer
i) = Integer
i forall a. Ord a => a -> a -> Bool
>= forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord forall a. Bounded a => a
minBound)
                              Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord forall a. Bounded a => a
maxBound)
litFitsInChar Literal
_               = Bool
False

litIsLifted :: Literal -> Bool
litIsLifted :: Literal -> Bool
litIsLifted (LitNumber LitNumType
nt Integer
_) = case LitNumType
nt of
  LitNumType
LitNumInteger -> Bool
True
  LitNumType
LitNumNatural -> Bool
True
  LitNumType
LitNumInt     -> Bool
False
  LitNumType
LitNumInt8    -> Bool
False
  LitNumType
LitNumInt16   -> Bool
False
  LitNumType
LitNumInt32   -> Bool
False
  LitNumType
LitNumInt64   -> Bool
False
  LitNumType
LitNumWord    -> Bool
False
  LitNumType
LitNumWord8   -> Bool
False
  LitNumType
LitNumWord16  -> Bool
False
  LitNumType
LitNumWord32  -> Bool
False
  LitNumType
LitNumWord64  -> Bool
False
litIsLifted Literal
_                  = Bool
False

{-
        Types
        ~~~~~
-}

-- | Find the Haskell 'Type' the literal occupies
literalType :: Literal -> Type
literalType :: Literal -> Type
literalType Literal
LitNullAddr       = Type
addrPrimTy
literalType (LitChar Char
_)       = Type
charPrimTy
literalType (LitString  ByteString
_)    = Type
addrPrimTy
literalType (LitFloat Rational
_)      = Type
floatPrimTy
literalType (LitDouble Rational
_)     = Type
doublePrimTy
literalType (LitLabel FastString
_ Maybe Int
_ FunctionOrData
_)  = Type
addrPrimTy
literalType (LitNumber LitNumType
lt Integer
_)  = case LitNumType
lt of
   LitNumType
LitNumInteger -> Type
integerTy
   LitNumType
LitNumNatural -> Type
naturalTy
   LitNumType
LitNumInt     -> Type
intPrimTy
   LitNumType
LitNumInt8    -> Type
int8PrimTy
   LitNumType
LitNumInt16   -> Type
int16PrimTy
   LitNumType
LitNumInt32   -> Type
int32PrimTy
   LitNumType
LitNumInt64   -> Type
int64PrimTy
   LitNumType
LitNumWord    -> Type
wordPrimTy
   LitNumType
LitNumWord8   -> Type
word8PrimTy
   LitNumType
LitNumWord16  -> Type
word16PrimTy
   LitNumType
LitNumWord32  -> Type
word32PrimTy
   LitNumType
LitNumWord64  -> Type
word64PrimTy
literalType (LitRubbish Bool
is_lifted) = TyCoVar -> ArgFlag -> Type -> Type
mkForAllTy TyCoVar
a ArgFlag
Inferred (TyCoVar -> Type
mkTyVarTy TyCoVar
a)
  where
    -- See Note [Rubbish literals]
    a :: TyCoVar
a | Bool
is_lifted = TyCoVar
alphaTyVar
      | Bool
otherwise = TyCoVar
alphaTyVarUnliftedRep

absentLiteralOf :: TyCon -> Maybe Literal
-- Return a literal of the appropriate primitive
-- TyCon, to use as a placeholder when it doesn't matter
-- Rubbish literals are handled in GHC.Core.Opt.WorkWrap.Utils, because
--  1. Looking at the TyCon is not enough, we need the actual type
--  2. This would need to return a type application to a literal
absentLiteralOf :: TyCon -> Maybe Literal
absentLiteralOf TyCon
tc = forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM TyCon Literal
absent_lits TyCon
tc

-- We do not use TyConEnv here to avoid import cycles.
absent_lits :: UniqFM TyCon Literal
absent_lits :: UniqFM TyCon Literal
absent_lits = forall elt key. [(Unique, elt)] -> UniqFM key elt
listToUFM_Directly
                        -- Explicitly construct the mape from the known
                        -- keys of these tyCons.
                        [ (Unique
addrPrimTyConKey,    Literal
LitNullAddr)
                        , (Unique
charPrimTyConKey,    Char -> Literal
LitChar Char
'x')
                        , (Unique
intPrimTyConKey,     Integer -> Literal
mkLitIntUnchecked Integer
0)
                        , (Unique
int8PrimTyConKey,    Integer -> Literal
mkLitInt8Unchecked Integer
0)
                        , (Unique
int16PrimTyConKey,   Integer -> Literal
mkLitInt16Unchecked Integer
0)
                        , (Unique
int32PrimTyConKey,   Integer -> Literal
mkLitInt32Unchecked Integer
0)
                        , (Unique
int64PrimTyConKey,   Integer -> Literal
mkLitInt64Unchecked Integer
0)
                        , (Unique
wordPrimTyConKey,    Integer -> Literal
mkLitWordUnchecked Integer
0)
                        , (Unique
word8PrimTyConKey,   Integer -> Literal
mkLitWord8Unchecked Integer
0)
                        , (Unique
word16PrimTyConKey,  Integer -> Literal
mkLitWord16Unchecked Integer
0)
                        , (Unique
word32PrimTyConKey,  Integer -> Literal
mkLitWord32Unchecked Integer
0)
                        , (Unique
word64PrimTyConKey,  Integer -> Literal
mkLitWord64Unchecked Integer
0)
                        , (Unique
floatPrimTyConKey,   Rational -> Literal
LitFloat Rational
0)
                        , (Unique
doublePrimTyConKey,  Rational -> Literal
LitDouble Rational
0)
                        ]

{-
        Comparison
        ~~~~~~~~~~
-}

cmpLit :: Literal -> Literal -> Ordering
cmpLit :: Literal -> Literal -> Ordering
cmpLit (LitChar      Char
a)     (LitChar       Char
b)     = Char
a forall a. Ord a => a -> a -> Ordering
`compare` Char
b
cmpLit (LitString    ByteString
a)     (LitString     ByteString
b)     = ByteString
a forall a. Ord a => a -> a -> Ordering
`compare` ByteString
b
cmpLit (Literal
LitNullAddr)        (Literal
LitNullAddr)         = Ordering
EQ
cmpLit (LitFloat     Rational
a)     (LitFloat      Rational
b)     = Rational
a forall a. Ord a => a -> a -> Ordering
`compare` Rational
b
cmpLit (LitDouble    Rational
a)     (LitDouble     Rational
b)     = Rational
a forall a. Ord a => a -> a -> Ordering
`compare` Rational
b
cmpLit (LitLabel     FastString
a Maybe Int
_ FunctionOrData
_) (LitLabel      FastString
b Maybe Int
_ FunctionOrData
_) = FastString
a FastString -> FastString -> Ordering
`lexicalCompareFS` FastString
b
cmpLit (LitNumber LitNumType
nt1 Integer
a)    (LitNumber LitNumType
nt2  Integer
b)
  = (LitNumType
nt1 forall a. Ord a => a -> a -> Ordering
`compare` LitNumType
nt2) forall a. Monoid a => a -> a -> a
`mappend` (Integer
a forall a. Ord a => a -> a -> Ordering
`compare` Integer
b)
cmpLit (LitRubbish Bool
b1)      (LitRubbish Bool
b2)       = Bool
b1 forall a. Ord a => a -> a -> Ordering
`compare` Bool
b2
cmpLit Literal
lit1 Literal
lit2
  | Int# -> Bool
isTrue# (forall a. a -> Int#
dataToTag# Literal
lit1 Int# -> Int# -> Int#
<# forall a. a -> Int#
dataToTag# Literal
lit2) = Ordering
LT
  | Bool
otherwise                                    = Ordering
GT

{-
        Printing
        ~~~~~~~~
* See Note [Printing of literals in Core]
-}

pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral SDoc -> SDoc
_       (LitChar Char
c)     = Char -> SDoc
pprPrimChar Char
c
pprLiteral SDoc -> SDoc
_       (LitString ByteString
s)   = ByteString -> SDoc
pprHsBytes ByteString
s
pprLiteral SDoc -> SDoc
_       (Literal
LitNullAddr)   = String -> SDoc
text String
"__NULL"
pprLiteral SDoc -> SDoc
_       (LitFloat Rational
f)    = Float -> SDoc
float (forall a. RealFloat a => Rational -> a
fromRat Rational
f) SDoc -> SDoc -> SDoc
<> SDoc
primFloatSuffix
pprLiteral SDoc -> SDoc
_       (LitDouble Rational
d)   = Double -> SDoc
double (forall a. RealFloat a => Rational -> a
fromRat Rational
d) SDoc -> SDoc -> SDoc
<> SDoc
primDoubleSuffix
pprLiteral SDoc -> SDoc
add_par (LitNumber LitNumType
nt Integer
i)
   = case LitNumType
nt of
       LitNumType
LitNumInteger -> (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal SDoc -> SDoc
add_par Integer
i
       LitNumType
LitNumNatural -> (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal SDoc -> SDoc
add_par Integer
i
       LitNumType
LitNumInt     -> Integer -> SDoc
pprPrimInt Integer
i
       LitNumType
LitNumInt8    -> Integer -> SDoc
pprPrimInt8 Integer
i
       LitNumType
LitNumInt16   -> Integer -> SDoc
pprPrimInt16 Integer
i
       LitNumType
LitNumInt32   -> Integer -> SDoc
pprPrimInt32 Integer
i
       LitNumType
LitNumInt64   -> Integer -> SDoc
pprPrimInt64 Integer
i
       LitNumType
LitNumWord    -> Integer -> SDoc
pprPrimWord Integer
i
       LitNumType
LitNumWord8   -> Integer -> SDoc
pprPrimWord8 Integer
i
       LitNumType
LitNumWord16  -> Integer -> SDoc
pprPrimWord16 Integer
i
       LitNumType
LitNumWord32  -> Integer -> SDoc
pprPrimWord32 Integer
i
       LitNumType
LitNumWord64  -> Integer -> SDoc
pprPrimWord64 Integer
i
pprLiteral SDoc -> SDoc
add_par (LitLabel FastString
l Maybe Int
mb FunctionOrData
fod) =
    SDoc -> SDoc
add_par (String -> SDoc
text String
"__label" SDoc -> SDoc -> SDoc
<+> SDoc
b SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr FunctionOrData
fod)
    where b :: SDoc
b = case Maybe Int
mb of
              Maybe Int
Nothing -> FastString -> SDoc
pprHsString FastString
l
              Just Int
x  -> SDoc -> SDoc
doubleQuotes (String -> SDoc
text (FastString -> String
unpackFS FastString
l forall a. [a] -> [a] -> [a]
++ Char
'@'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
x))
pprLiteral SDoc -> SDoc
_       (LitRubbish Bool
is_lifted)
  = String -> SDoc
text String
"__RUBBISH"
    SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
parens (if Bool
is_lifted then String -> SDoc
text String
"lifted" else String -> SDoc
text String
"unlifted")

pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
-- See Note [Printing of literals in Core].
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal SDoc -> SDoc
add_par Integer
i | Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0     = SDoc -> SDoc
add_par (Integer -> SDoc
integer Integer
i)
                        | Bool
otherwise = Integer -> SDoc
integer Integer
i

{-
Note [Printing of literals in Core]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The function `add_par` is used to wrap parenthesis around negative integers
(`LitInteger`) and labels (`LitLabel`), if they occur in a context requiring
an atomic thing (for example function application).

Although not all Core literals would be valid Haskell, we are trying to stay
as close as possible to Haskell syntax in the printing of Core, to make it
easier for a Haskell user to read Core.

To that end:
  * We do print parenthesis around negative `LitInteger`, because we print
  `LitInteger` using plain number literals (no prefix or suffix), and plain
  number literals in Haskell require parenthesis in contexts like function
  application (i.e. `1 - -1` is not valid Haskell).

  * We don't print parenthesis around other (negative) literals, because they
  aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's
  parser).

Literal         Output             Output if context requires
                                   an atom (if different)
-------         -------            ----------------------
LitChar         'a'#
LitString       "aaa"#
LitNullAddr     "__NULL"
LitInt          -1#
LitIntN         -1#N
LitWord          1##
LitWordN         1##N
LitFloat        -1.0#
LitDouble       -1.0##
LitInteger      -1                 (-1)
LitLabel        "__label" ...      ("__label" ...)
LitRubbish      "__RUBBISH"

Note [Rubbish literals]
~~~~~~~~~~~~~~~~~~~~~~~
During worker/wrapper after demand analysis, where an argument
is unused (absent) we do the following w/w split (supposing that
y is absent):

  f x y z = e
===>
  f x y z = $wf x z
  $wf x z = let y = <absent value>
            in e

Usually the binding for y is ultimately optimised away, and
even if not it should never be evaluated -- but that's the
way the w/w split starts off.

What is <absent value>?
* For lifted values <absent value> can be a call to 'error'.
* For primitive types like Int# or Word# we can use any random
  value of that type.
* But what about /unlifted/ but /boxed/ types like MutVar# or
  Array#?  Or /lifted/ but /strict/ values, such as a field of
  a strict data constructor.  For these we use LitRubbish.
  See Note [Absent errors] in GHC.Core.Opt.WorkWrap.Utils.hs

The literal (LitRubbish is_lifted)
has type
  LitRubbish :: forall (a :: TYPE LiftedRep). a     if is_lifted
  LitRubbish :: forall (a :: TYPE UnliftedRep). a   otherwise

So we might see a w/w split like
  $wf x z = let y :: Array# Int = (LitRubbish False) @(Array# Int)
            in e

Here are the moving parts, but see also Note [Absent errors] in
GHC.Core.Opt.WorkWrap.Utils

* We define LitRubbish as a constructor in GHC.Types.Literal.Literal

* It is given its polymorphic type by Literal.literalType

* GHC.Core.Opt.WorkWrap.Utils.mk_absent_let introduces a LitRubbish for absent
  arguments of boxed, unlifted type; or boxed, lifted arguments of strict data
  constructors.

* In CoreToSTG we convert (RubishLit @t) to just ().  STG is untyped, so this
  will work OK for both lifted and unlifted (but boxed) values. The important
  thing is that it is a heap pointer, which the garbage collector can follow if
  it encounters it.

  We considered maintaining LitRubbish in STG, and lowering it in the code
  generators, but it seems simpler to do it once and for all in CoreToSTG.

  In GHC.ByteCode.Asm we just lower it as a 0 literal, because it's all boxed to
  the host GC anyway.
-}