{-# LANGUAGE LambdaCase #-}
module GHC.StgToCmm.Lit (
cgLit, mkSimpleLit,
newStringCLit, newByteStringCLit
) where
import GHC.Prelude
import GHC.Platform
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Env
import GHC.Cmm
import GHC.Cmm.CLabel
import GHC.Cmm.Utils
import GHC.Types.Literal
import GHC.Types.RepType( runtimeRepPrimRep )
import GHC.Builtin.Types ( unitDataConId )
import GHC.Core.TyCon
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import Data.Char (ord)
newStringCLit :: String -> FCode CmmLit
newStringCLit :: String -> FCode CmmLit
newStringCLit String
str = ByteString -> FCode CmmLit
newByteStringCLit (String -> ByteString
BS8.pack String
str)
newByteStringCLit :: ByteString -> FCode CmmLit
newByteStringCLit :: ByteString -> FCode CmmLit
newByteStringCLit ByteString
bytes
= do { Unique
uniq <- FCode Unique
newUnique
; let (CmmLit
lit, GenCmmDecl (GenCmmStatics 'False) CmmTopInfo CmmGraph
decl) = CLabel
-> ByteString
-> (CmmLit, GenCmmDecl (GenCmmStatics 'False) CmmTopInfo CmmGraph)
forall (raw :: Bool) info stmt.
CLabel
-> ByteString -> (CmmLit, GenCmmDecl (GenCmmStatics raw) info stmt)
mkByteStringCLit (Unique -> CLabel
mkStringLitLabel Unique
uniq) ByteString
bytes
; GenCmmDecl (GenCmmStatics 'False) CmmTopInfo CmmGraph -> FCode ()
emitDecl GenCmmDecl (GenCmmStatics 'False) CmmTopInfo CmmGraph
decl
; CmmLit -> FCode CmmLit
forall a. a -> FCode a
forall (m :: * -> *) a. Monad m => a -> m a
return CmmLit
lit }
cgLit :: Literal -> FCode CmmExpr
cgLit :: Literal -> FCode CmmExpr
cgLit (LitString ByteString
s) =
CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> FCode CmmLit -> FCode CmmExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> FCode CmmLit
newByteStringCLit ByteString
s
cgLit (LitRubbish TypeOrConstraint
_ RuntimeRepType
rep) =
case String -> [PrimRep] -> PrimRep
forall a. HasCallStack => String -> [a] -> a
expectOnly String
"cgLit" [PrimRep]
prim_reps of
PrimRep
VoidRep -> String -> FCode CmmExpr
forall a. HasCallStack => String -> a
panic String
"cgLit:VoidRep"
PrimRep
LiftedRep -> CgIdInfo -> CmmExpr
idInfoToAmode (CgIdInfo -> CmmExpr) -> FCode CgIdInfo -> FCode CmmExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> FCode CgIdInfo
getCgIdInfo Id
unitDataConId
PrimRep
UnliftedRep -> CgIdInfo -> CmmExpr
idInfoToAmode (CgIdInfo -> CmmExpr) -> FCode CgIdInfo -> FCode CmmExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> FCode CgIdInfo
getCgIdInfo Id
unitDataConId
PrimRep
AddrRep -> Literal -> FCode CmmExpr
cgLit Literal
LitNullAddr
VecRep Int
n PrimElemRep
elem -> do
Platform
platform <- FCode Platform
getPlatform
let elem_lit :: CmmLit
elem_lit = Platform -> Literal -> CmmLit
mkSimpleLit Platform
platform (PrimRep -> Literal
num_rep_lit (PrimElemRep -> PrimRep
primElemRepToPrimRep PrimElemRep
elem))
CmmExpr -> FCode CmmExpr
forall a. a -> FCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CmmLit -> CmmExpr
CmmLit ([CmmLit] -> CmmLit
CmmVec (Int -> CmmLit -> [CmmLit]
forall a. Int -> a -> [a]
replicate Int
n CmmLit
elem_lit)))
PrimRep
prep -> Literal -> FCode CmmExpr
cgLit (PrimRep -> Literal
num_rep_lit PrimRep
prep)
where
prim_reps :: [PrimRep]
prim_reps = (() :: Constraint) => SDoc -> RuntimeRepType -> [PrimRep]
SDoc -> RuntimeRepType -> [PrimRep]
runtimeRepPrimRep (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cgLit") RuntimeRepType
rep
num_rep_lit :: PrimRep -> Literal
num_rep_lit PrimRep
IntRep = Integer -> Literal
mkLitIntUnchecked Integer
0
num_rep_lit PrimRep
Int8Rep = Integer -> Literal
mkLitInt8Unchecked Integer
0
num_rep_lit PrimRep
Int16Rep = Integer -> Literal
mkLitInt16Unchecked Integer
0
num_rep_lit PrimRep
Int32Rep = Integer -> Literal
mkLitInt32Unchecked Integer
0
num_rep_lit PrimRep
Int64Rep = Integer -> Literal
mkLitInt64Unchecked Integer
0
num_rep_lit PrimRep
WordRep = Integer -> Literal
mkLitWordUnchecked Integer
0
num_rep_lit PrimRep
Word8Rep = Integer -> Literal
mkLitWord8Unchecked Integer
0
num_rep_lit PrimRep
Word16Rep = Integer -> Literal
mkLitWord16Unchecked Integer
0
num_rep_lit PrimRep
Word32Rep = Integer -> Literal
mkLitWord32Unchecked Integer
0
num_rep_lit PrimRep
Word64Rep = Integer -> Literal
mkLitWord64Unchecked Integer
0
num_rep_lit PrimRep
FloatRep = Rational -> Literal
LitFloat Rational
0
num_rep_lit PrimRep
DoubleRep = Rational -> Literal
LitDouble Rational
0
num_rep_lit PrimRep
other = String -> SDoc -> Literal
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"num_rep_lit: Not a num lit" (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
other)
cgLit Literal
other_lit = do
Platform
platform <- FCode Platform
getPlatform
CmmExpr -> FCode CmmExpr
forall a. a -> FCode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CmmLit -> CmmExpr
CmmLit (Platform -> Literal -> CmmLit
mkSimpleLit Platform
platform Literal
other_lit))
mkSimpleLit :: Platform -> Literal -> CmmLit
mkSimpleLit :: Platform -> Literal -> CmmLit
mkSimpleLit Platform
platform = \case
(LitChar Char
c) -> Integer -> Width -> CmmLit
CmmInt (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c))
(Platform -> Width
wordWidth Platform
platform)
Literal
LitNullAddr -> Platform -> CmmLit
zeroCLit Platform
platform
(LitNumber LitNumType
LitNumInt Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i (Platform -> Width
wordWidth Platform
platform)
(LitNumber LitNumType
LitNumInt8 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W8
(LitNumber LitNumType
LitNumInt16 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W16
(LitNumber LitNumType
LitNumInt32 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W32
(LitNumber LitNumType
LitNumInt64 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W64
(LitNumber LitNumType
LitNumWord Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i (Platform -> Width
wordWidth Platform
platform)
(LitNumber LitNumType
LitNumWord8 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W8
(LitNumber LitNumType
LitNumWord16 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W16
(LitNumber LitNumType
LitNumWord32 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W32
(LitNumber LitNumType
LitNumWord64 Integer
i) -> Integer -> Width -> CmmLit
CmmInt Integer
i Width
W64
(LitFloat Rational
r) -> Rational -> Width -> CmmLit
CmmFloat Rational
r Width
W32
(LitDouble Rational
r) -> Rational -> Width -> CmmLit
CmmFloat Rational
r Width
W64
(LitLabel FastString
fs Maybe Int
ms FunctionOrData
fod)
-> let
labelSrc :: ForeignLabelSource
labelSrc = ForeignLabelSource
ForeignLabelInThisPackage
in CLabel -> CmmLit
CmmLabel (FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
fs Maybe Int
ms ForeignLabelSource
labelSrc FunctionOrData
fod)
Literal
other -> String -> SDoc -> CmmLit
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"mkSimpleLit" (Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
other)