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

\section[Literal]{@Literal@: literals}
-}

{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}

module Literal
        (
        -- * Main data type
          Literal(..)           -- Exported to ParseIface
        , LitNumType(..)

        -- ** Creating Literals
        , mkLitInt, mkLitIntWrap, mkLitIntWrapC
        , mkLitWord, mkLitWordWrap, mkLitWordWrapC
        , mkLitInt64, mkLitInt64Wrap
        , mkLitWord64, mkLitWord64Wrap
        , mkLitFloat, mkLitDouble
        , mkLitChar, mkLitString
        , mkLitInteger, mkLitNatural
        , mkLitNumber, mkLitNumberWrap

        -- ** Operations on Literals
        , literalType
        , absentLiteralOf
        , pprLiteral
        , litNumIsSigned
        , litNumCheckRange

        -- ** Predicates on Literals and their contents
        , litIsDupable, litIsTrivial, litIsLifted
        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
        , isZeroLit
        , litFitsInChar
        , litValue, isLitValue, isLitValue_maybe, mapLitValue

        -- ** Coercions
        , word2IntLit, int2WordLit
        , narrowLit
        , narrow8IntLit, narrow16IntLit, narrow32IntLit
        , narrow8WordLit, narrow16WordLit, narrow32WordLit
        , char2IntLit, int2CharLit
        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
        , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit
        ) where

#include "HsVersions.h"

import GhcPrelude

import TysPrim
import PrelNames
import Type
import TyCon
import Outputable
import FastString
import BasicTypes
import Binary
import Constants
import DynFlags
import Platform
import UniqFM
import Util

import Data.ByteString (ByteString)
import Data.Int
import Data.Word
import Data.Char
import Data.Maybe ( isJust )
import Data.Data ( Data )
import Data.Proxy
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 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 Type
                                -- ^ 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, used when an unlifted
                                -- binding is absent and has type
                                -- @forall (a :: 'TYPE' 'UnliftedRep'). a@.
                                -- May be lowered by code-gen to any possible
                                -- value. Also 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
DataType
Constr
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 -> DataType
Literal -> Constr
(forall b. Data b => b -> b) -> Literal -> Literal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Literal -> c Literal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cLitLabel :: Constr
$cLitDouble :: Constr
$cLitFloat :: Constr
$cLitRubbish :: Constr
$cLitNullAddr :: Constr
$cLitString :: Constr
$cLitNumber :: Constr
$cLitChar :: Constr
$tLiteral :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Literal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Literal -> u
gmapQ :: (forall d. Data d => d -> u) -> Literal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Literal -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Literal
Data

-- | Numeric literal type
data LitNumType
  = LitNumInteger -- ^ @Integer@ (see Note [Integer literals])
  | LitNumNatural -- ^ @Natural@ (see Note [Natural literals])
  | LitNumInt     -- ^ @Int#@ - according to target machine
  | LitNumInt64   -- ^ @Int64#@ - exactly 64 bits
  | LitNumWord    -- ^ @Word#@ - according to target machine
  | LitNumWord64  -- ^ @Word64#@ - exactly 64 bits
  deriving (Typeable LitNumType
DataType
Constr
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 -> DataType
LitNumType -> Constr
(forall b. Data b => b -> b) -> LitNumType -> LitNumType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LitNumType -> c LitNumType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cLitNumWord64 :: Constr
$cLitNumWord :: Constr
$cLitNumInt64 :: Constr
$cLitNumInt :: Constr
$cLitNumNatural :: Constr
$cLitNumInteger :: Constr
$tLitNumType :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> LitNumType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LitNumType -> u
gmapQ :: (forall d. Data d => d -> u) -> LitNumType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LitNumType -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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
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
(LitNumType -> LitNumType -> Bool)
-> (LitNumType -> LitNumType -> Bool) -> Eq LitNumType
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
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
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
$cp1Ord :: Eq LitNumType
Ord)

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

{-
Note [Integer literals]
~~~~~~~~~~~~~~~~~~~~~~~
An Integer literal is represented using, well, an Integer, to make it
easier to write RULEs for them. They also contain the Integer type, so
that e.g. literalType can return the right Type for them.

They only get converted into real Core,
    mkInteger [c1, c2, .., cn]
during the CorePrep phase, although TidyPgm looks ahead at what the
core will be, so that it can see whether it involves CAFs.

When we initally build an Integer literal, notably when
deserialising it from an interface file (see the Binary instance
below), we don't have convenient access to the mkInteger Id.  So we
just use an error thunk, and fill in the real Id when we do tcIfaceLit
in TcIface.

Note [Natural literals]
~~~~~~~~~~~~~~~~~~~~~~~
Similar to Integer literals.

-}

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

instance Binary Literal where
    put_ :: BinHandle -> Literal -> IO ()
put_ bh :: BinHandle
bh (LitChar aa :: Char
aa)     = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0; BinHandle -> Char -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Char
aa
    put_ bh :: BinHandle
bh (LitString ab :: ByteString
ab)   = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1; BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
ab
    put_ bh :: BinHandle
bh (Literal
LitNullAddr)    = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
    put_ bh :: BinHandle
bh (LitFloat ah :: Rational
ah)    = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3; BinHandle -> Rational -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Rational
ah
    put_ bh :: BinHandle
bh (LitDouble ai :: Rational
ai)   = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 4; BinHandle -> Rational -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Rational
ai
    put_ bh :: BinHandle
bh (LitLabel aj :: FastString
aj mb :: Maybe Int
mb fod :: FunctionOrData
fod)
        = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 5
             BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
aj
             BinHandle -> Maybe Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Int
mb
             BinHandle -> FunctionOrData -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FunctionOrData
fod
    put_ bh :: BinHandle
bh (LitNumber nt :: LitNumType
nt i :: Integer
i _)
        = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 6
             BinHandle -> LitNumType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LitNumType
nt
             BinHandle -> Integer -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
i
    put_ bh :: BinHandle
bh (Literal
LitRubbish)     = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 7
    get :: BinHandle -> IO Literal
get bh :: BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              0 -> do
                    Char
aa <- BinHandle -> IO Char
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Literal
LitChar Char
aa)
              1 -> do
                    ByteString
ab <- BinHandle -> IO ByteString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Literal
LitString ByteString
ab)
              2 -> do
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal
LitNullAddr)
              3 -> do
                    Rational
ah <- BinHandle -> IO Rational
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Literal
LitFloat Rational
ah)
              4 -> do
                    Rational
ai <- BinHandle -> IO Rational
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Literal
LitDouble Rational
ai)
              5 -> do
                    FastString
aj <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Maybe Int
mb <- BinHandle -> IO (Maybe Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    FunctionOrData
fod <- BinHandle -> IO FunctionOrData
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> Maybe Int -> FunctionOrData -> Literal
LitLabel FastString
aj Maybe Int
mb FunctionOrData
fod)
              6 -> do
                    LitNumType
nt <- BinHandle -> IO LitNumType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Integer
i  <- BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    let t :: Type
t = case LitNumType
nt of
                            LitNumInt     -> Type
intPrimTy
                            LitNumInt64   -> Type
int64PrimTy
                            LitNumWord    -> Type
wordPrimTy
                            LitNumWord64  -> Type
word64PrimTy
                            -- See Note [Integer literals]
                            LitNumInteger ->
                              String -> Type
forall a. String -> a
panic "Evaluated the place holder for mkInteger"
                            -- and Note [Natural literals]
                            LitNumNatural ->
                              String -> Type
forall a. String -> a
panic "Evaluated the place holder for mkNatural"
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt Integer
i Type
t)
              _ -> do
                    Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal
LitRubbish)

instance Outputable Literal where
    ppr :: Literal -> SDoc
ppr lit :: Literal
lit = (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral (\d :: SDoc
d -> SDoc
d) Literal
lit

instance Eq Literal where
    a :: Literal
a == :: Literal -> Literal -> Bool
== b :: Literal
b = case (Literal
a Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Literal
b) of { EQ -> Bool
True;   _ -> Bool
False }
    a :: Literal
a /= :: Literal -> Literal -> Bool
/= b :: Literal
b = case (Literal
a Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Literal
b) of { EQ -> Bool
False;  _ -> Bool
True  }

-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in
-- 'TrieMap.CoreMap'.
instance Ord Literal where
    a :: Literal
a <= :: Literal -> Literal -> Bool
<= b :: Literal
b = case (Literal
a Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Literal
b) of { LT -> Bool
True;  EQ -> Bool
True;  GT -> Bool
False }
    a :: Literal
a < :: Literal -> Literal -> Bool
<  b :: Literal
b = case (Literal
a Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Literal
b) of { LT -> Bool
True;  EQ -> Bool
False; GT -> Bool
False }
    a :: Literal
a >= :: Literal -> Literal -> Bool
>= b :: Literal
b = case (Literal
a Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Literal
b) of { LT -> Bool
False; EQ -> Bool
True;  GT -> Bool
True  }
    a :: Literal
a > :: Literal -> Literal -> Bool
>  b :: Literal
b = case (Literal
a Literal -> Literal -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Literal
b) of { LT -> Bool
False; EQ -> Bool
False; GT -> Bool
True  }
    compare :: Literal -> Literal -> Ordering
compare a :: Literal
a b :: Literal
b = Literal -> Literal -> Ordering
cmpLit Literal
a Literal
b

{-
        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.
-}

-- | Wrap a literal number according to its type
wrapLitNumber :: DynFlags -> Literal -> Literal
wrapLitNumber :: DynFlags -> Literal -> Literal
wrapLitNumber dflags :: DynFlags
dflags v :: Literal
v@(LitNumber nt :: LitNumType
nt i :: Integer
i t :: Type
t) = case LitNumType
nt of
  LitNumInt -> case Platform -> Int
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
    4 -> LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int32)) Type
t
    8 -> LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int64)) Type
t
    w :: Int
w -> String -> Literal
forall a. String -> a
panic ("wrapLitNumber: Unknown platformWordSize: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w)
  LitNumWord -> case Platform -> Int
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
    4 -> LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word32)) Type
t
    8 -> LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word64)) Type
t
    w :: Int
w -> String -> Literal
forall a. String -> a
panic ("wrapLitNumber: Unknown platformWordSize: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w)
  LitNumInt64   -> LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Int64)) Type
t
  LitNumWord64  -> LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word64)) Type
t
  LitNumInteger -> Literal
v
  LitNumNatural -> Literal
v
wrapLitNumber _ x :: Literal
x = Literal
x

-- | Create a numeric 'Literal' of the given type
mkLitNumberWrap :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumberWrap :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumberWrap dflags :: DynFlags
dflags nt :: LitNumType
nt i :: Integer
i t :: Type
t = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt Integer
i Type
t)

-- | Check that a given number is in the range of a numeric literal
litNumCheckRange :: DynFlags -> LitNumType -> Integer -> Bool
litNumCheckRange :: DynFlags -> LitNumType -> Integer -> Bool
litNumCheckRange dflags :: DynFlags
dflags nt :: LitNumType
nt i :: Integer
i = case LitNumType
nt of
     LitNumInt     -> DynFlags -> Integer -> Bool
inIntRange DynFlags
dflags Integer
i
     LitNumWord    -> DynFlags -> Integer -> Bool
inWordRange DynFlags
dflags Integer
i
     LitNumInt64   -> Integer -> Bool
inInt64Range Integer
i
     LitNumWord64  -> Integer -> Bool
inWord64Range Integer
i
     LitNumNatural -> Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
     LitNumInteger -> Bool
True

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

-- | Creates a 'Literal' of type @Int#@
mkLitInt :: DynFlags -> Integer -> Literal
mkLitInt :: DynFlags -> Integer -> Literal
mkLitInt dflags :: DynFlags
dflags x :: Integer
x   = ASSERT2( inIntRange dflags 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 :: DynFlags -> Integer -> Literal
mkLitIntWrap :: DynFlags -> Integer -> Literal
mkLitIntWrap dflags :: DynFlags
dflags i :: Integer
i = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (Literal -> Literal) -> Literal -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
mkLitIntUnchecked Integer
i

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

-- | 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 :: DynFlags -> Integer -> (Literal, Bool)
mkLitIntWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitIntWrapC dflags :: DynFlags
dflags i :: Integer
i = (Literal
n, Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
i')
  where
    n :: Literal
n@(LitNumber _ i' :: Integer
i' _) = DynFlags -> Integer -> Literal
mkLitIntWrap DynFlags
dflags Integer
i

-- | Creates a 'Literal' of type @Word#@
mkLitWord :: DynFlags -> Integer -> Literal
mkLitWord :: DynFlags -> Integer -> Literal
mkLitWord dflags :: DynFlags
dflags x :: Integer
x   = ASSERT2( inWordRange dflags 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 :: DynFlags -> Integer -> Literal
mkLitWordWrap :: DynFlags -> Integer -> Literal
mkLitWordWrap dflags :: DynFlags
dflags i :: Integer
i = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (Literal -> Literal) -> Literal -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
mkLitWordUnchecked Integer
i

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

-- | 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 :: DynFlags -> Integer -> (Literal, Bool)
mkLitWordWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitWordWrapC dflags :: DynFlags
dflags i :: Integer
i = (Literal
n, Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
i')
  where
    n :: Literal
n@(LitNumber _ i' :: Integer
i' _) = DynFlags -> Integer -> Literal
mkLitWordWrap DynFlags
dflags Integer
i

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

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

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

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

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

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

-- | 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 s :: String
s = ByteString -> Literal
LitString (FastString -> ByteString
fastStringToByteString (FastString -> ByteString) -> FastString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> FastString
mkFastString String
s)

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

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

inIntRange, inWordRange :: DynFlags -> Integer -> Bool
inIntRange :: DynFlags -> Integer -> Bool
inIntRange  dflags :: DynFlags
dflags x :: Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= DynFlags -> Integer
tARGET_MIN_INT DynFlags
dflags Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= DynFlags -> Integer
tARGET_MAX_INT DynFlags
dflags
inWordRange :: DynFlags -> Integer -> Bool
inWordRange dflags :: DynFlags
dflags x :: Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0                     Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= DynFlags -> Integer
tARGET_MAX_WORD DynFlags
dflags

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

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

inCharRange :: Char -> Bool
inCharRange :: Char -> Bool
inCharRange c :: Char
c =  Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\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 _ 0 _) = Bool
True
isZeroLit (LitFloat  0)     = Bool
True
isZeroLit (LitDouble 0)     = Bool
True
isZeroLit _                 = 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 l :: Literal
l = case Literal -> Maybe Integer
isLitValue_maybe Literal
l of
   Just x :: Integer
x  -> Integer
x
   Nothing -> String -> SDoc -> Integer
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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   c :: 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 _ i :: Integer
i _) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
isLitValue_maybe _                 = 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  :: DynFlags -> (Integer -> Integer) -> Literal -> Literal
mapLitValue :: DynFlags -> (Integer -> Integer) -> Literal -> Literal
mapLitValue _      f :: Integer -> Integer
f (LitChar   c :: 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 dflags :: DynFlags
dflags f :: Integer -> Integer
f (LitNumber nt :: LitNumType
nt i :: Integer
i t :: Type
t) = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags
                                                        (LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Integer -> Integer
f Integer
i) Type
t)
mapLitValue _      _ l :: Literal
l                  = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic "mapLitValue" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)

-- | Indicate if the `Literal` contains an 'Integer' value, e.g. 'Char',
-- 'Int', 'Word', 'LitInteger' and 'LitNatural'.
isLitValue  :: Literal -> Bool
isLitValue :: Literal -> Bool
isLitValue = Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Integer -> Bool)
-> (Literal -> Maybe Integer) -> Literal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Maybe Integer
isLitValue_maybe

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

narrow8IntLit, narrow16IntLit, narrow32IntLit,
  narrow8WordLit, narrow16WordLit, narrow32WordLit,
  char2IntLit, int2CharLit,
  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
  float2DoubleLit, double2FloatLit
  :: Literal -> Literal

word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
word2IntLit :: DynFlags -> Literal -> Literal
word2IntLit dflags :: DynFlags
dflags (LitNumber LitNumWord w :: Integer
w _)
  -- Map Word range [max_int+1, max_word]
  -- to Int range   [min_int  , -1]
  -- Range [0,max_int] has the same representation with both Int and Word
  | Integer
w Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DynFlags -> Integer
tARGET_MAX_INT DynFlags
dflags = DynFlags -> Integer -> Literal
mkLitInt DynFlags
dflags (Integer
w Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- DynFlags -> Integer
tARGET_MAX_WORD DynFlags
dflags Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1)
  | Bool
otherwise                 = DynFlags -> Integer -> Literal
mkLitInt DynFlags
dflags Integer
w
word2IntLit _ l :: Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic "word2IntLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)

int2WordLit :: DynFlags -> Literal -> Literal
int2WordLit dflags :: DynFlags
dflags (LitNumber LitNumInt i :: Integer
i _)
  -- Map Int range [min_int  , -1]
  -- to Word range [max_int+1, max_word]
  -- Range [0,max_int] has the same representation with both Int and Word
  | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0     = DynFlags -> Integer -> Literal
mkLitWord DynFlags
dflags (1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ DynFlags -> Integer
tARGET_MAX_WORD DynFlags
dflags Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)
  | Bool
otherwise = DynFlags -> Integer -> Literal
mkLitWord DynFlags
dflags Integer
i
int2WordLit _ l :: Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic "int2WordLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)

-- | Narrow a literal number (unchecked result range)
narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit :: Proxy a -> Literal -> Literal
narrowLit _ (LitNumber nt :: LitNumType
nt i :: Integer
i t :: Type
t) = LitNumType -> Integer -> Type -> 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)) Type
t
narrowLit _ l :: Literal
l                  = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic "narrowLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)

narrow8IntLit :: Literal -> Literal
narrow8IntLit   = Proxy Int8 -> Literal -> Literal
forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit (Proxy Int8
forall k (t :: k). Proxy t
Proxy :: Proxy Int8)
narrow16IntLit :: Literal -> Literal
narrow16IntLit  = Proxy Int16 -> Literal -> Literal
forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit (Proxy Int16
forall k (t :: k). Proxy t
Proxy :: Proxy Int16)
narrow32IntLit :: Literal -> Literal
narrow32IntLit  = Proxy Int32 -> Literal -> Literal
forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit (Proxy Int32
forall k (t :: k). Proxy t
Proxy :: Proxy Int32)
narrow8WordLit :: Literal -> Literal
narrow8WordLit  = Proxy Word8 -> Literal -> Literal
forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit (Proxy Word8
forall k (t :: k). Proxy t
Proxy :: Proxy Word8)
narrow16WordLit :: Literal -> Literal
narrow16WordLit = Proxy Word16 -> Literal -> Literal
forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit (Proxy Word16
forall k (t :: k). Proxy t
Proxy :: Proxy Word16)
narrow32WordLit :: Literal -> Literal
narrow32WordLit = Proxy Word32 -> Literal -> Literal
forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit (Proxy Word32
forall k (t :: k). Proxy t
Proxy :: Proxy Word32)

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

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

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

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

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

-- | A nonsense literal of type @forall (a :: 'TYPE' 'UnliftedRep'). a@.
rubbishLit :: Literal
rubbishLit :: Literal
rubbishLit = Literal
LitRubbish

{-
        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. CoreUtils.exprIsTrivial
litIsTrivial :: Literal -> Bool
litIsTrivial (LitString _)      = Bool
False
litIsTrivial (LitNumber nt :: LitNumType
nt _ _) = case LitNumType
nt of
  LitNumInteger -> Bool
False
  LitNumNatural -> Bool
False
  LitNumInt     -> Bool
True
  LitNumInt64   -> Bool
True
  LitNumWord    -> Bool
True
  LitNumWord64  -> Bool
True
litIsTrivial _                  = Bool
True

-- | True if code space does not go bad if we duplicate this literal
litIsDupable :: DynFlags -> Literal -> Bool
--      c.f. CoreUtils.exprIsDupable
litIsDupable :: DynFlags -> Literal -> Bool
litIsDupable _      (LitString _)      = Bool
False
litIsDupable dflags :: DynFlags
dflags (LitNumber nt :: LitNumType
nt i :: Integer
i _) = case LitNumType
nt of
  LitNumInteger -> DynFlags -> Integer -> Bool
inIntRange DynFlags
dflags Integer
i
  LitNumNatural -> DynFlags -> Integer -> Bool
inIntRange DynFlags
dflags Integer
i
  LitNumInt     -> Bool
True
  LitNumInt64   -> Bool
True
  LitNumWord    -> Bool
True
  LitNumWord64  -> Bool
True
litIsDupable _      _                  = Bool
True

litFitsInChar :: Literal -> Bool
litFitsInChar :: Literal -> Bool
litFitsInChar (LitNumber _ i :: 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 _                 = Bool
False

litIsLifted :: Literal -> Bool
litIsLifted :: Literal -> Bool
litIsLifted (LitNumber nt :: LitNumType
nt _ _) = case LitNumType
nt of
  LitNumInteger -> Bool
True
  LitNumNatural -> Bool
True
  LitNumInt     -> Bool
False
  LitNumInt64   -> Bool
False
  LitNumWord    -> Bool
False
  LitNumWord64  -> Bool
False
litIsLifted _                  = Bool
False

{-
        Types
        ~~~~~
-}

-- | Find the Haskell 'Type' the literal occupies
literalType :: Literal -> Type
literalType :: Literal -> Type
literalType LitNullAddr       = Type
addrPrimTy
literalType (LitChar _)       = Type
charPrimTy
literalType (LitString  _)    = Type
addrPrimTy
literalType (LitFloat _)      = Type
floatPrimTy
literalType (LitDouble _)     = Type
doublePrimTy
literalType (LitLabel _ _ _)  = Type
addrPrimTy
literalType (LitNumber _ _ t :: Type
t) = Type
t
literalType (Literal
LitRubbish)      = TyCoVar -> ArgFlag -> Type -> Type
mkForAllTy TyCoVar
a ArgFlag
Inferred (TyCoVar -> Type
mkTyVarTy TyCoVar
a)
  where
    a :: TyCoVar
a = 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 WwLib, 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 tc :: TyCon
tc = UniqFM Literal -> Name -> Maybe Literal
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM UniqFM Literal
absent_lits (TyCon -> Name
tyConName TyCon
tc)

absent_lits :: UniqFM Literal
absent_lits :: UniqFM Literal
absent_lits = [(Unique, Literal)] -> UniqFM Literal
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
listToUFM [ (Unique
addrPrimTyConKey,    Literal
LitNullAddr)
                        , (Unique
charPrimTyConKey,    Char -> Literal
LitChar 'x')
                        , (Unique
intPrimTyConKey,     Integer -> Literal
mkLitIntUnchecked 0)
                        , (Unique
int64PrimTyConKey,   Integer -> Literal
mkLitInt64Unchecked 0)
                        , (Unique
wordPrimTyConKey,    Integer -> Literal
mkLitWordUnchecked 0)
                        , (Unique
word64PrimTyConKey,  Integer -> Literal
mkLitWord64Unchecked 0)
                        , (Unique
floatPrimTyConKey,   Rational -> Literal
LitFloat 0)
                        , (Unique
doublePrimTyConKey,  Rational -> Literal
LitDouble 0)
                        ]

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

cmpLit :: Literal -> Literal -> Ordering
cmpLit :: Literal -> Literal -> Ordering
cmpLit (LitChar      a :: Char
a)     (LitChar       b :: Char
b)     = Char
a Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Char
b
cmpLit (LitString    a :: ByteString
a)     (LitString     b :: 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     a :: Rational
a)     (LitFloat      b :: Rational
b)     = Rational
a Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Rational
b
cmpLit (LitDouble    a :: Rational
a)     (LitDouble     b :: Rational
b)     = Rational
a Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Rational
b
cmpLit (LitLabel     a :: FastString
a _ _) (LitLabel      b :: FastString
b _ _) = FastString
a FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` FastString
b
cmpLit (LitNumber nt1 :: LitNumType
nt1 a :: Integer
a _)  (LitNumber nt2 :: LitNumType
nt2  b :: Integer
b _)
  | LitNumType
nt1 LitNumType -> LitNumType -> Bool
forall a. Eq a => a -> a -> Bool
== LitNumType
nt2 = Integer
a   Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Integer
b
  | Bool
otherwise  = LitNumType
nt1 LitNumType -> LitNumType -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` LitNumType
nt2
cmpLit (Literal
LitRubbish)         (Literal
LitRubbish)          = Ordering
EQ
cmpLit lit1 :: Literal
lit1 lit2 :: Literal
lit2
  | Literal -> Int
litTag Literal
lit1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Literal -> Int
litTag Literal
lit2 = Ordering
LT
  | Bool
otherwise                 = Ordering
GT

litTag :: Literal -> Int
litTag :: Literal -> Int
litTag (LitChar      _)   = 1
litTag (LitString    _)   = 2
litTag (Literal
LitNullAddr)      = 3
litTag (LitFloat     _)   = 4
litTag (LitDouble    _)   = 5
litTag (LitLabel _ _ _)   = 6
litTag (LitNumber  {})    = 7
litTag (Literal
LitRubbish)       = 8

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

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

pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
-- See Note [Printing of literals in Core].
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal add_par :: SDoc -> SDoc
add_par i :: Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 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#
LitInt64        -1L#
LitWord          1##
LitWord64        1L##
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#?   We need a literal value of that type.

That is 'LitRubbish'.  Since we need a rubbish literal for
many boxed, unlifted types, we say that LitRubbish has type
  LitRubbish :: forall (a :: TYPE UnliftedRep). a

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

Recall that (TYPE UnliftedRep) is the kind of boxed, unlifted
heap pointers.

Here are the moving parts:

* We define LitRubbish as a constructor in Literal.Literal

* It is given its polymoprhic type by Literal.literalType

* WwLib.mk_absent_let introduces a LitRubbish for absent
  arguments of boxed, unlifted type.

* In CoreToSTG we convert (RubishLit @t) to just ().  STG is
  untyped, so it doesn't matter that it points to a lifted
  value. 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 genreators, but it seems simpler to do it
  once and for all in CoreToSTG.

  In ByteCodeAsm we just lower it as a 0 literal, because
  it's all boxed and lifted to the host GC anyway.
-}