{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
module Literal
(
Literal(..)
, LitNumType(..)
, mkLitInt, mkLitIntWrap, mkLitIntWrapC
, mkLitWord, mkLitWordWrap, mkLitWordWrapC
, mkLitInt64, mkLitInt64Wrap
, mkLitWord64, mkLitWord64Wrap
, mkLitFloat, mkLitDouble
, mkLitChar, mkLitString
, mkLitInteger, mkLitNatural
, mkLitNumber, mkLitNumberWrap
, literalType
, absentLiteralOf
, pprLiteral
, litNumIsSigned
, litNumCheckRange
, litIsDupable, litIsTrivial, litIsLifted
, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
, isZeroLit
, litFitsInChar
, litValue, isLitValue, isLitValue_maybe, mapLitValue
, 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 GHC.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 )
data Literal
= LitChar Char
| LitNumber !LitNumType !Integer Type
| LitString ByteString
| LitNullAddr
| LitRubbish
| LitFloat Rational
| LitDouble Rational
| LitLabel FastString (Maybe Int) FunctionOrData
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
data LitNumType
= LitNumInteger
| LitNumNatural
| LitNumInt
| LitNumInt64
| LitNumWord
| LitNumWord64
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)
litNumIsSigned :: LitNumType -> Bool
litNumIsSigned :: LitNumType -> Bool
litNumIsSigned LitNumType
nt = case LitNumType
nt of
LitNumType
LitNumInteger -> Bool
True
LitNumType
LitNumNatural -> Bool
False
LitNumType
LitNumInt -> Bool
True
LitNumType
LitNumInt64 -> Bool
True
LitNumType
LitNumWord -> Bool
False
LitNumType
LitNumWord64 -> Bool
False
instance Binary LitNumType where
put_ :: BinHandle -> LitNumType -> IO ()
put_ BinHandle
bh 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 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_ BinHandle
bh (LitChar Char
aa) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0; BinHandle -> Char -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Char
aa
put_ BinHandle
bh (LitString ByteString
ab) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1; BinHandle -> ByteString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
ab
put_ BinHandle
bh (Literal
LitNullAddr) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
put_ BinHandle
bh (LitFloat Rational
ah) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3; BinHandle -> Rational -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Rational
ah
put_ BinHandle
bh (LitDouble Rational
ai) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4; BinHandle -> Rational -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Rational
ai
put_ BinHandle
bh (LitLabel FastString
aj Maybe Int
mb FunctionOrData
fod)
= do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
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_ BinHandle
bh (LitNumber LitNumType
nt Integer
i Type
_)
= do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
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_ BinHandle
bh (Literal
LitRubbish) = do BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
get :: BinHandle -> IO Literal
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> do
Char
aa <- 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)
Word8
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)
Word8
2 -> do
Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal
LitNullAddr)
Word8
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)
Word8
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)
Word8
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)
Word8
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
LitNumType
LitNumInt -> Type
intPrimTy
LitNumType
LitNumInt64 -> Type
int64PrimTy
LitNumType
LitNumWord -> Type
wordPrimTy
LitNumType
LitNumWord64 -> Type
word64PrimTy
LitNumType
LitNumInteger ->
String -> Type
forall a. String -> a
panic String
"Evaluated the place holder for mkInteger"
LitNumType
LitNumNatural ->
String -> Type
forall a. String -> a
panic String
"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)
Word8
_ -> do
Literal -> IO Literal
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal
LitRubbish)
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
instance Ord Literal where
compare :: Literal -> Literal -> Ordering
compare = Literal -> Literal -> Ordering
cmpLit
wrapLitNumber :: DynFlags -> Literal -> Literal
wrapLitNumber :: DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags v :: Literal
v@(LitNumber LitNumType
nt Integer
i Type
t) = case LitNumType
nt of
LitNumType
LitNumInt -> case Platform -> PlatformWordSize
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
PlatformWordSize
PW4 -> 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
PlatformWordSize
PW8 -> 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
LitNumType
LitNumWord -> case Platform -> PlatformWordSize
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
PlatformWordSize
PW4 -> 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
PlatformWordSize
PW8 -> 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
LitNumType
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
LitNumType
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
LitNumType
LitNumInteger -> Literal
v
LitNumType
LitNumNatural -> Literal
v
wrapLitNumber DynFlags
_ Literal
x = Literal
x
mkLitNumberWrap :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumberWrap :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumberWrap DynFlags
dflags LitNumType
nt Integer
i Type
t = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt Integer
i Type
t)
litNumCheckRange :: DynFlags -> LitNumType -> Integer -> Bool
litNumCheckRange :: DynFlags -> LitNumType -> Integer -> Bool
litNumCheckRange DynFlags
dflags LitNumType
nt Integer
i = case LitNumType
nt of
LitNumType
LitNumInt -> DynFlags -> Integer -> Bool
inIntRange DynFlags
dflags Integer
i
LitNumType
LitNumWord -> DynFlags -> Integer -> Bool
inWordRange DynFlags
dflags Integer
i
LitNumType
LitNumInt64 -> Integer -> Bool
inInt64Range Integer
i
LitNumType
LitNumWord64 -> Integer -> Bool
inWord64Range Integer
i
LitNumType
LitNumNatural -> Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
LitNumType
LitNumInteger -> Bool
True
mkLitNumber :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumber :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumber DynFlags
dflags LitNumType
nt Integer
i Type
t =
ASSERT2(litNumCheckRange dflags nt i, integer i)
(LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt Integer
i Type
t)
mkLitInt :: DynFlags -> Integer -> Literal
mkLitInt :: DynFlags -> Integer -> Literal
mkLitInt DynFlags
dflags Integer
x = ASSERT2( inIntRange dflags x, integer x )
(Integer -> Literal
mkLitIntUnchecked Integer
x)
mkLitIntWrap :: DynFlags -> Integer -> Literal
mkLitIntWrap :: DynFlags -> Integer -> Literal
mkLitIntWrap DynFlags
dflags Integer
i = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (Literal -> Literal) -> Literal -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
mkLitIntUnchecked Integer
i
mkLitIntUnchecked :: Integer -> Literal
mkLitIntUnchecked :: Integer -> Literal
mkLitIntUnchecked Integer
i = LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
LitNumInt Integer
i Type
intPrimTy
mkLitIntWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitIntWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitIntWrapC DynFlags
dflags 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' Type
_) = DynFlags -> Integer -> Literal
mkLitIntWrap DynFlags
dflags Integer
i
mkLitWord :: DynFlags -> Integer -> Literal
mkLitWord :: DynFlags -> Integer -> Literal
mkLitWord DynFlags
dflags Integer
x = ASSERT2( inWordRange dflags x, integer x )
(Integer -> Literal
mkLitWordUnchecked Integer
x)
mkLitWordWrap :: DynFlags -> Integer -> Literal
mkLitWordWrap :: DynFlags -> Integer -> Literal
mkLitWordWrap DynFlags
dflags Integer
i = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (Literal -> Literal) -> Literal -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
mkLitWordUnchecked Integer
i
mkLitWordUnchecked :: Integer -> Literal
mkLitWordUnchecked :: Integer -> Literal
mkLitWordUnchecked Integer
i = LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
LitNumWord Integer
i Type
wordPrimTy
mkLitWordWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitWordWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitWordWrapC DynFlags
dflags 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' Type
_) = DynFlags -> Integer -> Literal
mkLitWordWrap DynFlags
dflags Integer
i
mkLitInt64 :: Integer -> Literal
mkLitInt64 :: Integer -> Literal
mkLitInt64 Integer
x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)
mkLitInt64Wrap :: DynFlags -> Integer -> Literal
mkLitInt64Wrap :: DynFlags -> Integer -> Literal
mkLitInt64Wrap DynFlags
dflags Integer
i = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (Literal -> Literal) -> Literal -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
mkLitInt64Unchecked Integer
i
mkLitInt64Unchecked :: Integer -> Literal
mkLitInt64Unchecked :: Integer -> Literal
mkLitInt64Unchecked Integer
i = LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
LitNumInt64 Integer
i Type
int64PrimTy
mkLitWord64 :: Integer -> Literal
mkLitWord64 :: Integer -> Literal
mkLitWord64 Integer
x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)
mkLitWord64Wrap :: DynFlags -> Integer -> Literal
mkLitWord64Wrap :: DynFlags -> Integer -> Literal
mkLitWord64Wrap DynFlags
dflags Integer
i = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags (Literal -> Literal) -> Literal -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
mkLitWord64Unchecked Integer
i
mkLitWord64Unchecked :: Integer -> Literal
mkLitWord64Unchecked :: Integer -> Literal
mkLitWord64Unchecked Integer
i = LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
LitNumWord64 Integer
i Type
word64PrimTy
mkLitFloat :: Rational -> Literal
mkLitFloat :: Rational -> Literal
mkLitFloat = Rational -> Literal
LitFloat
mkLitDouble :: Rational -> Literal
mkLitDouble :: Rational -> Literal
mkLitDouble = Rational -> Literal
LitDouble
mkLitChar :: Char -> Literal
mkLitChar :: Char -> Literal
mkLitChar = Char -> Literal
LitChar
mkLitString :: String -> Literal
mkLitString :: String -> Literal
mkLitString String
s = ByteString -> Literal
LitString (FastString -> ByteString
bytesFS (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 Integer
x Type
ty = LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
LitNumInteger Integer
x Type
ty
mkLitNatural :: Integer -> Type -> Literal
mkLitNatural :: Integer -> Type -> Literal
mkLitNatural Integer
x 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 DynFlags
dflags 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 DynFlags
dflags Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
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 Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
inInt64Range, inWord64Range :: Integer -> Bool
inInt64Range :: Integer -> Bool
inInt64Range 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 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 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
isZeroLit :: Literal -> Bool
isZeroLit :: Literal -> Bool
isZeroLit (LitNumber LitNumType
_ Integer
0 Type
_) = Bool
True
isZeroLit (LitFloat Rational
0) = Bool
True
isZeroLit (LitDouble Rational
0) = Bool
True
isZeroLit Literal
_ = Bool
False
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)
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 Type
_) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
isLitValue_maybe Literal
_ = Maybe Integer
forall a. Maybe a
Nothing
mapLitValue :: DynFlags -> (Integer -> Integer) -> Literal -> Literal
mapLitValue :: DynFlags -> (Integer -> Integer) -> Literal -> Literal
mapLitValue DynFlags
_ 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 DynFlags
dflags Integer -> Integer
f (LitNumber LitNumType
nt Integer
i Type
t) = DynFlags -> Literal -> Literal
wrapLitNumber DynFlags
dflags
(LitNumType -> Integer -> Type -> Literal
LitNumber LitNumType
nt (Integer -> Integer
f Integer
i) Type
t)
mapLitValue DynFlags
_ 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)
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
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 DynFlags
dflags (LitNumber LitNumType
LitNumWord Integer
w Type
_)
| 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
- Integer
1)
| Bool
otherwise = DynFlags -> Integer -> Literal
mkLitInt DynFlags
dflags Integer
w
word2IntLit DynFlags
_ Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"word2IntLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
int2WordLit :: DynFlags -> Literal -> Literal
int2WordLit DynFlags
dflags (LitNumber LitNumType
LitNumInt Integer
i Type
_)
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = DynFlags -> Integer -> Literal
mkLitWord DynFlags
dflags (Integer
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 DynFlags
_ Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"int2WordLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit :: Proxy a -> Literal -> Literal
narrowLit Proxy a
_ (LitNumber LitNumType
nt Integer
i 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 Proxy a
_ 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)
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 Char
c) = Integer -> Literal
mkLitIntUnchecked (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Char -> Int
ord Char
c))
char2IntLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"char2IntLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
int2CharLit :: Literal -> Literal
int2CharLit (LitNumber LitNumType
_ Integer
i Type
_) = Char -> Literal
LitChar (Int -> Char
chr (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i))
int2CharLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"int2CharLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
float2IntLit :: Literal -> Literal
float2IntLit (LitFloat Rational
f) = Integer -> Literal
mkLitIntUnchecked (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
f)
float2IntLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"float2IntLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
int2FloatLit :: Literal -> Literal
int2FloatLit (LitNumber LitNumType
_ Integer
i Type
_) = Rational -> Literal
LitFloat (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
i)
int2FloatLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"int2FloatLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
double2IntLit :: Literal -> Literal
double2IntLit (LitDouble Rational
f) = Integer -> Literal
mkLitIntUnchecked (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
f)
double2IntLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"double2IntLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
int2DoubleLit :: Literal -> Literal
int2DoubleLit (LitNumber LitNumType
_ Integer
i Type
_) = Rational -> Literal
LitDouble (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
i)
int2DoubleLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"int2DoubleLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
float2DoubleLit :: Literal -> Literal
float2DoubleLit (LitFloat Rational
f) = Rational -> Literal
LitDouble Rational
f
float2DoubleLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"float2DoubleLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
double2FloatLit :: Literal -> Literal
double2FloatLit (LitDouble Rational
d) = Rational -> Literal
LitFloat Rational
d
double2FloatLit Literal
l = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"double2FloatLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l)
nullAddrLit :: Literal
nullAddrLit :: Literal
nullAddrLit = Literal
LitNullAddr
rubbishLit :: Literal
rubbishLit :: Literal
rubbishLit = Literal
LitRubbish
litIsTrivial :: Literal -> Bool
litIsTrivial :: Literal -> Bool
litIsTrivial (LitString ByteString
_) = Bool
False
litIsTrivial (LitNumber LitNumType
nt Integer
_ Type
_) = case LitNumType
nt of
LitNumType
LitNumInteger -> Bool
False
LitNumType
LitNumNatural -> Bool
False
LitNumType
LitNumInt -> Bool
True
LitNumType
LitNumInt64 -> Bool
True
LitNumType
LitNumWord -> Bool
True
LitNumType
LitNumWord64 -> Bool
True
litIsTrivial Literal
_ = Bool
True
litIsDupable :: DynFlags -> Literal -> Bool
litIsDupable :: DynFlags -> Literal -> Bool
litIsDupable DynFlags
_ (LitString ByteString
_) = Bool
False
litIsDupable DynFlags
dflags (LitNumber LitNumType
nt Integer
i Type
_) = case LitNumType
nt of
LitNumType
LitNumInteger -> DynFlags -> Integer -> Bool
inIntRange DynFlags
dflags Integer
i
LitNumType
LitNumNatural -> DynFlags -> Integer -> Bool
inIntRange DynFlags
dflags Integer
i
LitNumType
LitNumInt -> Bool
True
LitNumType
LitNumInt64 -> Bool
True
LitNumType
LitNumWord -> Bool
True
LitNumType
LitNumWord64 -> Bool
True
litIsDupable DynFlags
_ Literal
_ = Bool
True
litFitsInChar :: Literal -> Bool
litFitsInChar :: Literal -> Bool
litFitsInChar (LitNumber LitNumType
_ Integer
i Type
_) = 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
_ Type
_) = case LitNumType
nt of
LitNumType
LitNumInteger -> Bool
True
LitNumType
LitNumNatural -> Bool
True
LitNumType
LitNumInt -> Bool
False
LitNumType
LitNumInt64 -> Bool
False
LitNumType
LitNumWord -> Bool
False
LitNumType
LitNumWord64 -> Bool
False
litIsLifted Literal
_ = Bool
False
literalType :: Literal -> Type
literalType :: Literal -> Type
literalType Literal
LitNullAddr = Type
addrPrimTy
literalType (LitChar Char
_) = Type
charPrimTy
literalType (LitString ByteString
_) = Type
addrPrimTy
literalType (LitFloat Rational
_) = Type
floatPrimTy
literalType (LitDouble Rational
_) = Type
doublePrimTy
literalType (LitLabel FastString
_ Maybe Int
_ FunctionOrData
_) = Type
addrPrimTy
literalType (LitNumber LitNumType
_ Integer
_ 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
absentLiteralOf :: TyCon -> Maybe Literal
absentLiteralOf 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 Char
'x')
, (Unique
intPrimTyConKey, Integer -> Literal
mkLitIntUnchecked Integer
0)
, (Unique
int64PrimTyConKey, Integer -> Literal
mkLitInt64Unchecked Integer
0)
, (Unique
wordPrimTyConKey, Integer -> Literal
mkLitWordUnchecked Integer
0)
, (Unique
word64PrimTyConKey, Integer -> Literal
mkLitWord64Unchecked Integer
0)
, (Unique
floatPrimTyConKey, Rational -> Literal
LitFloat Rational
0)
, (Unique
doublePrimTyConKey, Rational -> Literal
LitDouble Rational
0)
]
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 Maybe Int
_ FunctionOrData
_) (LitLabel FastString
b Maybe Int
_ FunctionOrData
_) = FastString
a FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` FastString
b
cmpLit (LitNumber LitNumType
nt1 Integer
a Type
_) (LitNumber LitNumType
nt2 Integer
b Type
_)
| 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 Literal
lit1 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 Char
_) = Int
1
litTag (LitString ByteString
_) = Int
2
litTag (Literal
LitNullAddr) = Int
3
litTag (LitFloat Rational
_) = Int
4
litTag (LitDouble Rational
_) = Int
5
litTag (LitLabel FastString
_ Maybe Int
_ FunctionOrData
_) = Int
6
litTag (LitNumber {}) = Int
7
litTag (Literal
LitRubbish) = Int
8
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
pprLiteral SDoc -> SDoc
_ (LitChar Char
c) = Char -> SDoc
pprPrimChar Char
c
pprLiteral SDoc -> SDoc
_ (LitString ByteString
s) = ByteString -> SDoc
pprHsBytes ByteString
s
pprLiteral SDoc -> SDoc
_ (Literal
LitNullAddr) = String -> SDoc
text String
"__NULL"
pprLiteral SDoc -> SDoc
_ (LitFloat Rational
f) = Float -> SDoc
float (Rational -> Float
forall a. RealFloat a => Rational -> a
fromRat Rational
f) SDoc -> SDoc -> SDoc
<> SDoc
primFloatSuffix
pprLiteral SDoc -> SDoc
_ (LitDouble Rational
d) = Double -> SDoc
double (Rational -> Double
forall a. RealFloat a => Rational -> a
fromRat Rational
d) SDoc -> SDoc -> SDoc
<> SDoc
primDoubleSuffix
pprLiteral SDoc -> SDoc
add_par (LitNumber LitNumType
nt Integer
i Type
_)
= case LitNumType
nt of
LitNumType
LitNumInteger -> (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal SDoc -> SDoc
add_par Integer
i
LitNumType
LitNumNatural -> (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal SDoc -> SDoc
add_par Integer
i
LitNumType
LitNumInt -> Integer -> SDoc
pprPrimInt Integer
i
LitNumType
LitNumInt64 -> Integer -> SDoc
pprPrimInt64 Integer
i
LitNumType
LitNumWord -> Integer -> SDoc
pprPrimWord Integer
i
LitNumType
LitNumWord64 -> Integer -> SDoc
pprPrimWord64 Integer
i
pprLiteral SDoc -> SDoc
add_par (LitLabel FastString
l Maybe Int
mb FunctionOrData
fod) =
SDoc -> SDoc
add_par (String -> SDoc
text String
"__label" SDoc -> SDoc -> SDoc
<+> SDoc
b SDoc -> SDoc -> SDoc
<+> FunctionOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr FunctionOrData
fod)
where b :: SDoc
b = case Maybe Int
mb of
Maybe Int
Nothing -> FastString -> SDoc
pprHsString FastString
l
Just Int
x -> SDoc -> SDoc
doubleQuotes (String -> SDoc
text (FastString -> String
unpackFS FastString
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'@'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show Int
x))
pprLiteral SDoc -> SDoc
_ (Literal
LitRubbish) = String -> SDoc
text String
"__RUBBISH"
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
pprIntegerVal SDoc -> SDoc
add_par Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = SDoc -> SDoc
add_par (Integer -> SDoc
integer Integer
i)
| Bool
otherwise = Integer -> SDoc
integer Integer
i