{-# 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 { uniq <- FCode Unique
newUnique
; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes
; emitDecl decl
; return 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. HasDebugCallStack => String -> [a] -> a
expectOnly String
"cgLit" [PrimRep]
prim_reps of
BoxedRep Maybe Levity
_ -> 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 <- FCode Platform
getPlatform
let elem_lit = Platform -> Literal -> CmmLit
mkSimpleLit Platform
platform (PrimRep -> Literal
num_rep_lit (PrimElemRep -> PrimRep
primElemRepToPrimRep PrimElemRep
elem))
pure (CmmLit (CmmVec (replicate n elem_lit)))
PrimRep
prep -> Literal -> FCode CmmExpr
cgLit (PrimRep -> Literal
num_rep_lit PrimRep
prep)
where
prim_reps :: [PrimRep]
prim_reps = HasDebugCallStack => 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 <- FCode Platform
getPlatform
pure (CmmLit (mkSimpleLit platform 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 FunctionOrData
fod)
-> let
labelSrc :: ForeignLabelSource
labelSrc = ForeignLabelSource
ForeignLabelInThisPackage
in CLabel -> CmmLit
CmmLabel (FastString -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
fs 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)