    {-# 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)