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

-}

{-# LANGUAGE 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, mkLitWordUnchecked
        , mkLitInt8, mkLitInt8Wrap, mkLitInt8Unchecked
        , mkLitWord8, mkLitWord8Wrap, mkLitWord8Unchecked
        , mkLitInt16, mkLitInt16Wrap, mkLitInt16Unchecked
        , mkLitWord16, mkLitWord16Wrap, mkLitWord16Unchecked
        , mkLitInt32, mkLitInt32Wrap, mkLitInt32Unchecked
        , mkLitWord32, mkLitWord32Wrap, mkLitWord32Unchecked
        , mkLitInt64, mkLitInt64Wrap, mkLitInt64Unchecked
        , mkLitWord64, mkLitWord64Wrap, mkLitWord64Unchecked
        , mkLitFloat, mkLitDouble
        , mkLitChar, mkLitString
        , mkLitBigNat
        , mkLitNumber, mkLitNumberWrap, mkLitNumberMaybe

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

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

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

import GHC.Prelude

import GHC.Builtin.Types.Prim
import GHC.Core.Type( Type, RuntimeRepType, mkForAllTy, mkTyVarTy, typeOrConstraintKind )
import GHC.Core.TyCo.Compare( nonDetCmpType )
import GHC.Types.Var
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.Utils.Panic
import GHC.Utils.Encoding

import Data.ByteString (ByteString)
import Data.Int
import Data.Word
import Data.Char
import Data.Data ( Data )
import GHC.Exts( isTrue#, dataToTag#, (<#) )
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 that are 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                  -- ^ A nonsense value; See Note [Rubbish literals].
      TypeOrConstraint          -- t_or_c: whether this is a type or a constraint
      RuntimeRepType            -- rr: a type of kind RuntimeRep
      -- The type of the literal is forall (a::TYPE rr). a
      --                         or forall (a::CONSTRAINT rr). a
      --
      -- INVARIANT: the Type has no free variables
      --    and so substitution etc can ignore it

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

  | LitLabel   FastString FunctionOrData
                                -- ^ A label literal. Parameters:
                                --
                                -- 1) The name of the symbol mentioned in the
                                --    declaration
                                --
                                -- 2) Flag indicating whether the symbol
                                --    references a function or a data
  deriving Typeable Literal
Typeable Literal =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Literal -> c Literal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Literal)
-> (Literal -> Constr)
-> (Literal -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Literal -> Literal)
-> (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 u. (forall d. Data d => d -> u) -> Literal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Literal -> m Literal)
-> Data Literal
Literal -> Constr
Literal -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Literal
$ctoConstr :: Literal -> Constr
toConstr :: Literal -> Constr
$cdataTypeOf :: Literal -> DataType
dataTypeOf :: Literal -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Literal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Literal)
$cgmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
gmapT :: (forall b. Data b => b -> b) -> Literal -> Literal
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Literal -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Literal -> m Literal
Data

-- | Numeric literal type
data LitNumType
  = LitNumBigNat  -- ^ @Bignat@ (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
Typeable LitNumType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> LitNumType -> c LitNumType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LitNumType)
-> (LitNumType -> Constr)
-> (LitNumType -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> LitNumType -> LitNumType)
-> (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 u. (forall d. Data d => d -> u) -> LitNumType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LitNumType -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LitNumType -> m LitNumType)
-> Data LitNumType
LitNumType -> Constr
LitNumType -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LitNumType -> c LitNumType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LitNumType -> c LitNumType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LitNumType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LitNumType
$ctoConstr :: LitNumType -> Constr
toConstr :: LitNumType -> Constr
$cdataTypeOf :: LitNumType -> DataType
dataTypeOf :: LitNumType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LitNumType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LitNumType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LitNumType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LitNumType)
$cgmapT :: (forall b. Data b => b -> b) -> LitNumType -> LitNumType
gmapT :: (forall b. Data b => b -> b) -> LitNumType -> LitNumType
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LitNumType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LitNumType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> LitNumType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LitNumType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LitNumType -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LitNumType -> m LitNumType
Data,Int -> LitNumType
LitNumType -> Int
LitNumType -> [LitNumType]
LitNumType -> LitNumType
LitNumType -> LitNumType -> [LitNumType]
LitNumType -> LitNumType -> LitNumType -> [LitNumType]
(LitNumType -> LitNumType)
-> (LitNumType -> LitNumType)
-> (Int -> LitNumType)
-> (LitNumType -> Int)
-> (LitNumType -> [LitNumType])
-> (LitNumType -> LitNumType -> [LitNumType])
-> (LitNumType -> LitNumType -> [LitNumType])
-> (LitNumType -> LitNumType -> LitNumType -> [LitNumType])
-> Enum 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
$csucc :: LitNumType -> LitNumType
succ :: LitNumType -> LitNumType
$cpred :: LitNumType -> LitNumType
pred :: LitNumType -> LitNumType
$ctoEnum :: Int -> LitNumType
toEnum :: Int -> LitNumType
$cfromEnum :: LitNumType -> Int
fromEnum :: LitNumType -> Int
$cenumFrom :: LitNumType -> [LitNumType]
enumFrom :: LitNumType -> [LitNumType]
$cenumFromThen :: LitNumType -> LitNumType -> [LitNumType]
enumFromThen :: LitNumType -> LitNumType -> [LitNumType]
$cenumFromTo :: LitNumType -> LitNumType -> [LitNumType]
enumFromTo :: LitNumType -> LitNumType -> [LitNumType]
$cenumFromThenTo :: LitNumType -> LitNumType -> LitNumType -> [LitNumType]
enumFromThenTo :: LitNumType -> LitNumType -> LitNumType -> [LitNumType]
Enum,LitNumType -> LitNumType -> Bool
(LitNumType -> LitNumType -> Bool)
-> (LitNumType -> LitNumType -> Bool) -> Eq LitNumType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LitNumType -> LitNumType -> Bool
== :: LitNumType -> LitNumType -> Bool
$c/= :: LitNumType -> LitNumType -> Bool
/= :: LitNumType -> LitNumType -> Bool
Eq,Eq LitNumType
Eq LitNumType =>
(LitNumType -> LitNumType -> Ordering)
-> (LitNumType -> LitNumType -> Bool)
-> (LitNumType -> LitNumType -> Bool)
-> (LitNumType -> LitNumType -> Bool)
-> (LitNumType -> LitNumType -> Bool)
-> (LitNumType -> LitNumType -> LitNumType)
-> (LitNumType -> LitNumType -> LitNumType)
-> Ord 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
$ccompare :: LitNumType -> LitNumType -> Ordering
compare :: LitNumType -> LitNumType -> Ordering
$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
>= :: LitNumType -> LitNumType -> Bool
$cmax :: LitNumType -> LitNumType -> LitNumType
max :: LitNumType -> LitNumType -> LitNumType
$cmin :: LitNumType -> LitNumType -> LitNumType
min :: LitNumType -> LitNumType -> LitNumType
Ord)

-- | Indicate if a numeric literal type supports negative numbers
litNumIsSigned :: LitNumType -> Bool
litNumIsSigned :: LitNumType -> Bool
litNumIsSigned LitNumType
nt = case LitNumType
nt of
  LitNumType
LitNumBigNat  -> 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
LitNumBigNat  -> Maybe Word
forall a. Maybe a
Nothing
  LitNumType
LitNumInt     -> Word -> Maybe Word
forall a. a -> Maybe a
Just (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> Int
platformWordSizeInBits Platform
platform))
  LitNumType
LitNumInt8    -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
8
  LitNumType
LitNumInt16   -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
16
  LitNumType
LitNumInt32   -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
32
  LitNumType
LitNumInt64   -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
64
  LitNumType
LitNumWord    -> Word -> Maybe Word
forall a. a -> Maybe a
Just (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> Int
platformWordSizeInBits Platform
platform))
  LitNumType
LitNumWord8   -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
8
  LitNumType
LitNumWord16  -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
16
  LitNumType
LitNumWord32  -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
32
  LitNumType
LitNumWord64  -> Word -> Maybe Word
forall a. a -> Maybe a
Just Word
64

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

{-
Note [BigNum literals]
~~~~~~~~~~~~~~~~~~~~~~
GHC supports 2 kinds of arbitrary precision numbers (a.k.a BigNum):

   * data Natural = NS Word# | NB BigNat#

   * data Integer = IS Int# | IN BigNat# | IP BigNat#

In the past, we had Core constructors to represent Integer and Natural literals.
These literals were then lowered into their real Core representation only in
Core prep. The issue with this approach is that literals have two
representations and we have to ensure that we handle them the same everywhere
(in every optimisation, etc.).

For example (0 :: Integer) was representable in Core with both:

    Lit (LitNumber LitNumInteger 0)                          -- literal
    App (Var integerISDataCon) (Lit (LitNumber LitNumInt 0)) -- real representation

Nowadays we always use the real representation for Integer and Natural literals.
However we still have two representations for BigNat# literals. BigNat# literals
are still lowered in Core prep into a call to a constructor function (BigNat# is
ByteArray# and we don't have ByteArray# literals yet so we have to build them at
runtime).

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_ :: WriteBinHandle -> Literal -> IO ()
put_ WriteBinHandle
bh (LitChar Char
aa)     = do WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0; WriteBinHandle -> Char -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Char
aa
    put_ WriteBinHandle
bh (LitString ByteString
ab)   = do WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1; WriteBinHandle -> ByteString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ByteString
ab
    put_ WriteBinHandle
bh (Literal
LitNullAddr)    = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    put_ WriteBinHandle
bh (LitFloat Rational
ah)    = do WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3; WriteBinHandle -> Rational -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Rational
ah
    put_ WriteBinHandle
bh (LitDouble Rational
ai)   = do WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4; WriteBinHandle -> Rational -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Rational
ai
    put_ WriteBinHandle
bh (LitLabel FastString
aj FunctionOrData
fod)
        = do WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5
             WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
aj
             WriteBinHandle -> FunctionOrData -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FunctionOrData
fod
    put_ WriteBinHandle
bh (LitNumber LitNumType
nt Integer
i)
        = do WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
6
             WriteBinHandle -> LitNumType -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh LitNumType
nt
             WriteBinHandle -> Integer -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Integer
i
    put_ WriteBinHandle
_ lit :: Literal
lit@(LitRubbish {}) = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Binary LitRubbish" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
lit)
     -- We use IfaceLitRubbish; see Note [Rubbish literals], item (6)

    get :: ReadBinHandle -> IO Literal
get ReadBinHandle
bh = do
            h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
            case h of
              Word8
0 -> do
                    aa <- ReadBinHandle -> IO Char
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                    return (LitChar aa)
              Word8
1 -> do
                    ab <- ReadBinHandle -> IO ByteString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                    return (LitString ab)
              Word8
2 -> Literal -> IO Literal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal
LitNullAddr)
              Word8
3 -> do
                    ah <- ReadBinHandle -> IO Rational
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                    return (LitFloat ah)
              Word8
4 -> do
                    ai <- ReadBinHandle -> IO Rational
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                    return (LitDouble ai)
              Word8
5 -> do
                    aj <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                    fod <- get bh
                    return (LitLabel aj fod)
              Word8
6 -> do
                    nt <- ReadBinHandle -> IO LitNumType
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                    i  <- get bh
                    return (LitNumber nt i)
              Word8
_ -> String -> SDoc -> IO Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Binary:Literal" (Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
h))


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

instance Eq Literal where
    Literal
a == :: Literal -> Literal -> Bool
== Literal
b = Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Literal
a Literal
b Ordering -> Ordering -> Bool
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
LitNumBigNat
    | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     -> String -> Literal
forall a. HasCallStack => String -> a
panic String
"mkLitNumberWrap: trying to create a negative BigNat"
    | 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 (a -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> a
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                = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumWrap" (Literal -> SDoc
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                 = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumWrapCoerce: not a number" (Literal -> SDoc
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             -> String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumNarrow: got invalid literal" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
litNumNarrow LitNumType
_ Platform
_ Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litNumNarrow: invalid literal" (Literal -> SDoc
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 =
    Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Integer
m_lower Bool -> Bool -> Bool
&&
    Bool -> (Integer -> Bool) -> Maybe Integer -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<=) Maybe Integer
m_upper
  where
    (Maybe Integer
m_lower, Maybe Integer
m_upper) = Platform -> LitNumType -> (Maybe Integer, Maybe Integer)
litNumRange Platform
platform LitNumType
nt

-- | Get the literal range
litNumRange :: Platform -> LitNumType -> (Maybe Integer, Maybe Integer)
litNumRange :: Platform -> LitNumType -> (Maybe Integer, Maybe Integer)
litNumRange Platform
platform LitNumType
nt = case LitNumType
nt of
     LitNumType
LitNumInt     -> (Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Platform -> Integer
platformMinInt Platform
platform), Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Platform -> Integer
platformMaxInt Platform
platform))
     LitNumType
LitNumWord    -> (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0, Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Platform -> Integer
platformMaxWord Platform
platform))
     LitNumType
LitNumInt8    -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Int8
     LitNumType
LitNumInt16   -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Int16
     LitNumType
LitNumInt32   -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Int32
     LitNumType
LitNumInt64   -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Int64
     LitNumType
LitNumWord8   -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Word8
     LitNumType
LitNumWord16  -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Word16
     LitNumType
LitNumWord32  -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Word32
     LitNumType
LitNumWord64  -> forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range @Word64
     LitNumType
LitNumBigNat  -> (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0, Maybe Integer
forall a. Maybe a
Nothing)
  where
    bounded_range :: forall a . (Integral a, Bounded a) => (Maybe Integer,Maybe Integer)
    bounded_range :: forall a. (Integral a, Bounded a) => (Maybe Integer, Maybe Integer)
bounded_range = case forall a. (Bounded a, Integral a) => (Integer, Integer)
boundedRange @a of
      (Integer
mi,Integer
ma) -> (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
mi, Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
ma)

-- | 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 =
  Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Platform -> LitNumType -> Integer -> Bool
litNumCheckRange Platform
platform LitNumType
nt Integer
i) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
i)
  (LitNumType -> Integer -> Literal
LitNumber LitNumType
nt Integer
i)

-- | Create a numeric 'Literal' of the given type if it is in range
mkLitNumberMaybe :: Platform -> LitNumType -> Integer -> Maybe Literal
mkLitNumberMaybe :: Platform -> LitNumType -> Integer -> Maybe Literal
mkLitNumberMaybe Platform
platform LitNumType
nt Integer
i
  | Platform -> LitNumType -> Integer -> Bool
litNumCheckRange Platform
platform LitNumType
nt Integer
i = Literal -> Maybe Literal
forall a. a -> Maybe a
Just (LitNumType -> Integer -> Literal
LitNumber LitNumType
nt Integer
i)
  | Bool
otherwise                      = Maybe Literal
forall a. Maybe a
Nothing

-- | Creates a 'Literal' of type @Int#@
mkLitInt :: Platform -> Integer -> Literal
mkLitInt :: Platform -> Integer -> Literal
mkLitInt Platform
platform Integer
x = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer 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 Integer -> Integer -> Bool
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Platform -> Integer -> Bool
platformInWordRange Platform
platform Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer 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 Integer -> Integer -> Bool
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int8 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitInt8Unchecked Integer
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 (Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Int8
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word8 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitWord8Unchecked Integer
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 (Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Word8
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int16 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitInt16Unchecked Integer
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 (Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Int16
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word16 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitWord16Unchecked Integer
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 (Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Word16
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int32 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitInt32Unchecked Integer
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 (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Int32
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word32 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitWord32Unchecked Integer
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 (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Word32
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Int64 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitInt64Unchecked Integer
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 (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Int64
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 = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (forall a. (Bounded a, Integral a) => Integer -> Bool
inBoundedRange @Word64 Integer
x) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x) (Integer -> Literal
mkLitWord64Unchecked Integer
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 (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Word64
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 [] = ByteString -> Literal
LitString ByteString
forall a. Monoid a => a
mempty
mkLitString String
s  = ByteString -> Literal
LitString (String -> ByteString
utf8EncodeByteString String
s)

mkLitBigNat :: Integer -> Literal
mkLitBigNat :: Integer -> Literal
mkLitBigNat Integer
x = Bool -> SDoc -> Literal -> Literal
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0) (Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
x)
                    (LitNumType -> Integer -> Literal
LitNumber LitNumType
LitNumBigNat Integer
x)

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

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

boundedRange :: forall a. (Bounded a, Integral a) => (Integer,Integer)
boundedRange :: forall a. (Bounded a, Integral a) => (Integer, Integer)
boundedRange = (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound :: a), a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound :: a))

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

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

inCharRange :: Char -> Bool
inCharRange :: Char -> Bool
inCharRange Char
c =  Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
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' and numbers.
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 -> String -> SDoc -> Integer
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"litValue" (Literal -> SDoc
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)     = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c
isLitValue_maybe (LitNumber LitNumType
_ Integer
i)   = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
isLitValue_maybe Literal
_                 = Maybe Integer
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 (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Char -> Integer) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f (Integer -> Integer) -> (Char -> Integer) -> Char -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Char -> Int) -> Char -> Integer
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                  = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mapLitValue" (Literal -> SDoc
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' (a -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i :: a))
narrowLit' LitNumType
_   Literal
l                = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"narrowLit" (Literal -> SDoc
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                 = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"convertToWordLit" (Literal -> SDoc
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                 = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"convertToIntLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)

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

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

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

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

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

{-
        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
LitNumBigNat  -> 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
LitNumBigNat  -> Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Platform -> Integer
platformMaxWord Platform
platform Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
8 -- arbitrary, reasonable
      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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
forall a. Bounded a => a
minBound)
                              Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
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
LitNumBigNat  -> 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
  -- Even RUBBISH[LiftedRep] is unlifted, as rubbish values are always evaluated.

{-
        Types
        ~~~~~
-}

-- | Find the Haskell 'Type' the literal occupies
literalType :: Literal -> Type
literalType :: Literal -> RuntimeRepType
literalType Literal
LitNullAddr       = RuntimeRepType
addrPrimTy
literalType (LitChar Char
_)       = RuntimeRepType
charPrimTy
literalType (LitString  ByteString
_)    = RuntimeRepType
addrPrimTy
literalType (LitFloat Rational
_)      = RuntimeRepType
floatPrimTy
literalType (LitDouble Rational
_)     = RuntimeRepType
doublePrimTy
literalType (LitLabel FastString
_ FunctionOrData
_)    = RuntimeRepType
addrPrimTy
literalType (LitNumber LitNumType
lt Integer
_)  = case LitNumType
lt of
   LitNumType
LitNumBigNat  -> RuntimeRepType
byteArrayPrimTy
   LitNumType
LitNumInt     -> RuntimeRepType
intPrimTy
   LitNumType
LitNumInt8    -> RuntimeRepType
int8PrimTy
   LitNumType
LitNumInt16   -> RuntimeRepType
int16PrimTy
   LitNumType
LitNumInt32   -> RuntimeRepType
int32PrimTy
   LitNumType
LitNumInt64   -> RuntimeRepType
int64PrimTy
   LitNumType
LitNumWord    -> RuntimeRepType
wordPrimTy
   LitNumType
LitNumWord8   -> RuntimeRepType
word8PrimTy
   LitNumType
LitNumWord16  -> RuntimeRepType
word16PrimTy
   LitNumType
LitNumWord32  -> RuntimeRepType
word32PrimTy
   LitNumType
LitNumWord64  -> RuntimeRepType
word64PrimTy

-- LitRubbish: see Note [Rubbish literals]
literalType (LitRubbish TypeOrConstraint
torc RuntimeRepType
rep)
  = ForAllTyBinder -> RuntimeRepType -> RuntimeRepType
mkForAllTy (TyCoVar -> ForAllTyFlag -> ForAllTyBinder
forall var argf. var -> argf -> VarBndr var argf
Bndr TyCoVar
a ForAllTyFlag
Inferred) (TyCoVar -> RuntimeRepType
mkTyVarTy TyCoVar
a)
  where
    a :: TyCoVar
a = RuntimeRepType -> TyCoVar
mkTemplateKindVar (TypeOrConstraint -> RuntimeRepType -> RuntimeRepType
typeOrConstraintKind TypeOrConstraint
torc RuntimeRepType
rep)

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

cmpLit :: Literal -> Literal -> Ordering
cmpLit :: Literal -> Literal -> Ordering
cmpLit (LitChar      Char
a)     (LitChar       Char
b)     = Char
a Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Char
b
cmpLit (LitString    ByteString
a)     (LitString     ByteString
b)     = ByteString
a ByteString -> ByteString -> Ordering
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 Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Rational
b
cmpLit (LitDouble    Rational
a)     (LitDouble     Rational
b)     = Rational
a Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Rational
b
cmpLit (LitLabel     FastString
a FunctionOrData
_)   (LitLabel      FastString
b FunctionOrData
_)   = FastString
a FastString -> FastString -> Ordering
`lexicalCompareFS` FastString
b
cmpLit (LitNumber LitNumType
nt1 Integer
a)    (LitNumber LitNumType
nt2  Integer
b)
  = (LitNumType
nt1 LitNumType -> LitNumType -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` LitNumType
nt2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (Integer
a Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
b)
cmpLit (LitRubbish TypeOrConstraint
tc1 RuntimeRepType
b1)  (LitRubbish TypeOrConstraint
tc2 RuntimeRepType
b2)  = (TypeOrConstraint
tc1 TypeOrConstraint -> TypeOrConstraint -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` TypeOrConstraint
tc2) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
                                                   (RuntimeRepType
b1 RuntimeRepType -> RuntimeRepType -> Ordering
`nonDetCmpType` RuntimeRepType
b2)
cmpLit Literal
lit1 Literal
lit2
  | Int# -> Bool
isTrue# (Literal -> Int#
forall a. DataToTag a => a -> Int#
dataToTag# Literal
lit1 Int# -> Int# -> Int#
<# Literal -> Int#
forall a. DataToTag 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
forall doc. IsLine doc => String -> doc
text String
"__NULL"
pprLiteral SDoc -> SDoc
_       (LitFloat Rational
f)    = Float -> SDoc
forall doc. IsLine doc => Float -> doc
float (Rational -> Float
forall a. RealFloat a => Rational -> a
fromRat Rational
f) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primFloatSuffix
pprLiteral SDoc -> SDoc
_       (LitDouble Rational
d)   = Double -> SDoc
forall doc. IsLine doc => Double -> doc
double (Rational -> Double
forall a. RealFloat a => Rational -> a
fromRat Rational
d) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
primDoubleSuffix
pprLiteral SDoc -> SDoc
_       (LitNumber LitNumType
nt Integer
i)
   = case LitNumType
nt of
       LitNumType
LitNumBigNat  -> Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer 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 FunctionOrData
fod) =
    SDoc -> SDoc
add_par (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__label" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FastString -> SDoc
pprHsString FastString
l SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FunctionOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr FunctionOrData
fod)
pprLiteral SDoc -> SDoc
_       (LitRubbish TypeOrConstraint
torc RuntimeRepType
rep)
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RUBBISH" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (RuntimeRepType -> SDoc
forall a. Outputable a => a -> SDoc
ppr RuntimeRepType
rep)
  where
  pp_tc :: SDoc
pp_tc = case TypeOrConstraint
torc of
           TypeOrConstraint
TypeLike       -> SDoc
forall doc. IsOutput doc => doc
empty
           TypeOrConstraint
ConstraintLike -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[c]"

{-
Note [Printing of literals in Core]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The function `add_par` is used to wrap parenthesis around 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##
LitBigNat       1
LitLabel        "__label" ...      ("__label" ...)
LitRubbish      "RUBBISH[...]"

Note [Rubbish literals]
~~~~~~~~~~~~~~~~~~~~~~~
Sometimes, we need to cough up a rubbish value of a certain type that is used
in place of dead code we thus aim to eliminate. The value of a dead occurrence
has no effect on the dynamic semantics of the program, so we can pick any value
of the same representation.

Exploiting the results of absence analysis in worker/wrapper is a scenario where
we need such a rubbish value, see examples in Note [Absent fillers] in
GHC.Core.Opt.WorkWrap.Utils.

It's completely undefined what the *value* of a rubbish value is, e.g., we could
pick @0#@ for @Int#@ or @42#@; it mustn't matter where it's inserted into a Core
program. We embed these rubbish values in the 'LitRubbish' case of the 'Literal'
data type. Here are the moving parts:

1. Source Haskell: No way to produce rubbish lits in source syntax. Purely
   an IR feature.

2. Core: 'LitRubbish' carries a `Type` of kind RuntimeRep,
   describing the runtime representation of the literal (is it a
   pointer, an unboxed Double#, or whatever).

   We have it that `RUBBISH[rr]` has type `forall (a :: TYPE rr). a`.
   See the `LitRubbish` case of `literalType`.

   The function GHC.Core.Make.mkLitRubbish makes a Core rubbish literal of
   a given type.  It obeys the following invariants:

   INVARIANT 1: 'rr' has no free variables. Main reason: we don't need to run
   substitutions and free variable finders over Literal. The rules around
   levity/runtime-rep polymorphism naturally uphold this invariant.

   INVARIANT 2: we never make a rubbish literal of type (a ~# b). Reason:
   see Note [Core type and coercion invariant] in GHC.Core.  We can't substitute
   a LitRubbish inside a coercion, so it's best not to make one. They are zero
   width anyway, so passing absent ones around costs nothing.  If we wanted
   an absent filler of type (a ~# b) we should use (Coercion (UnivCo ...)),
   but it doesn't seem worth making a new UnivCoProvenance for this purpose.

   This is sad, though: see #18983.

3. STG: The type app in `RUBBISH[IntRep] @Int# :: Int#` is erased and we get
   the (untyped) 'StgLit' `RUBBISH[IntRep] :: Int#` in STG.

   It's treated mostly opaque, with the exception of the Unariser, where we
   take apart a case scrutinisation on, or arg occurrence of, e.g.,
   `RUBBISH[TupleRep[IntRep,DoubleRep]]` (which may stand in for `(# Int#, Double# #)`)
   into its sub-parts `RUBBISH[IntRep]` and `RUBBISH[DoubleRep]`, similar to
   unboxed tuples.

   See 'unariseLiteral_maybe' and also Note [Post-unarisation invariants].

4. Cmm: We translate 'LitRubbish' to their actual rubbish value in 'cgLit'.
   The particulars are boring, and only matter when debugging illicit use of
   a rubbish value; see Modes of failure below.

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

6. IfaceSyn: `Literal` is part of `IfaceSyn`, but `Type` really isn't.  So in
   the passage from Core to Iface we put LitRubbish into its own IfaceExpr data
   constructor, IfaceLitRubbish. The remaining constructors of Literal are
   fine as IfaceSyn.

Wrinkles

a) Why do we put the `Type` (of kind RuntimeRep) inside the literal?  Could
   we not instead /apply/ the literal to that RuntimeRep?  Alas no, because
   then LitRubbish :: forall (rr::RuntimeRep) (a::TYPE rr). a
   and that's an ill-formed type because its kind is `TYPE rr`, which escapes
   the binding site of `rr`. Annoying.

b) A rubbish literal is not bottom, and replies True to exprOkForSpeculation.
   For unboxed types there is no bottom anyway.  If we have
       let (x::Int#) = RUBBISH[IntRep] @Int#
   we want to convert that to a case!  We want to leave it as a let, and
   probably discard it as dead code soon after because x is unused.

c) We can see a rubbish literal at the head of an application chain.
   Most obviously, pretty much every rubbish literal is the head of a
   type application e.g. `RUBBISH[IntRep] @Int#`.  But see also
   Note [How a rubbish literal can be the head of an application]

c) Literal is in Ord, because (and only because) we use Ord on AltCon when
   building a TypeMap. Annoying.  We use `nonDetCmpType` here; the
   non-determinism won't matter because it's only used in TrieMap.
   Moreover, rubbish literals should not appear in patterns anyway.

d) Why not lower LitRubbish in CoreToStg? Because it enables us to use
   LitRubbish when unarising unboxed sums in the future, and it allows
   rubbish values of e.g.  VecRep, for which we can't cough up dummy
   values in STG.

Modes of failure
----------------
Suppose there is a bug in GHC, and a rubbish value is used after all. That is
undefined behavior, of course, but let us list a few examples for failure modes:

 a) For an value of unboxed numeric type like `Int#`, we just use a silly
    value like 42#. The error might propagate indefinitely, hence we better
    pick a rather unique literal. Same for Word, Floats, Char and VecRep.
 b) For AddrRep (like String lits), we emit a null pointer, resulting in a
    definitive segfault when accessed.
 c) For boxed values, unlifted or not, we use a pointer to a fixed closure,
    like `()`, so that the GC has a pointer to follow.
    If we use that pointer as an 'Array#', we will likely access fields of the
    array that don't exist, and a seg-fault is likely, but not guaranteed.
    If we use that pointer as `Either Int Bool`, we might try to access the
    'Int' field of the 'Left' constructor (which has the same ConTag as '()'),
    which doesn't exists. In the best case, we'll find an invalid pointer in its
    position and get a seg-fault, in the worst case the error manifests only one
    or two indirections later.

Note [How a rubbish literal can be the head of an application]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this (#19824):

    h :: T3 -> Int -> blah
    h _ (I# n) = ...

    f :: (T1 -> T2 -> T3) -> T4 -> blah
    f g x = ....(h (g n s) x)...

Demand analysis finds that h does not use its first argument, and w/w's h to

    {-# INLINE h #-}
    h a b = case b of I# n -> $wh n

Demand analysis also finds that f does not use its first arg,
so the worker for f look like

    $wf x = let g = RUBBISH in
            ....(h (g n s) x)...

Now we inline g to get:

    $wf x = ....(h (RUBBISH n s) x)...

And lo, until we inline `h`, we have that application of
RUBBISH in $wf's RHS.  But surely `h` will inline? Not if the
arguments look boring.  Well, RUBBISH doesn't look boring.  But it
could be a bit more complicated like
   f g x = let t = ...(g n s)...
           in ...(h t x)...

and now the call looks more boring.  Anyway, the point is that we
might reasonably see RUBBISH at the head of an application chain.

It would be fine to rewrite
  RUBBISH @(ta->tb->tr) a b  --->   RUBBISH @tr
but we don't currently do so.

It is NOT ok to discard the entire continuation:
  case RUBBISH @ty of DEFAULT -> blah
does not return RUBBISH!
-}