{-# LANGUAGE LambdaCase #-}

-----------------------------------------------------------------------------
--
-- Stg to C-- code generation: literals
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

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
-- ^ Make a global definition for the string,
-- and return its label
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
 -- not unpackFS; we want the UTF-8 byte stream.
cgLit (LitRubbish TypeOrConstraint
_ RuntimeRepType
rep) =
  case String -> [PrimRep] -> PrimRep
forall a. HasCallStack => String -> [a] -> a
expectOnly String
"cgLit" [PrimRep]
prim_reps of -- Note [Post-unarisation invariants]
    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 Maybe Int
ms FunctionOrData
fod)
     -> let -- TODO: Literal labels might not actually be in the current package...
            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)