{-# 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  { 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
 -- 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]
    PrimRep
VoidRep     -> String -> FCode CmmExpr
forall a. HasCallStack => String -> a
panic String
"cgLit:VoidRep"   -- ditto
    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 -- 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)