GHC/StgToCmm/Lit.hs

    {-# LANGUAGE CPP, LambdaCase #-}

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

    module GHC.StgToCmm.Lit (
        cgLit, mkSimpleLit,
        newStringCLit, newByteStringCLit
      ) where

    #include "HsVersions.h"

    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.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 str = newByteStringCLit (BS8.pack str)

    newByteStringCLit :: ByteString -> FCode CmmLit
    newByteStringCLit bytes
      = do  { uniq <- newUnique
            ; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes
            ; emitDecl decl
            ; return lit }

    cgLit :: Literal -> FCode CmmExpr
    cgLit (LitString s) =
      CmmLit <$> newByteStringCLit s
     -- not unpackFS; we want the UTF-8 byte stream.
    cgLit (LitRubbish preps) =
      case expectOnly "cgLit:Rubbish" preps of -- Note [Post-unarisation invariants]
        VoidRep     -> panic "cgLit:VoidRep"   -- dito
        LiftedRep   -> idInfoToAmode <$> getCgIdInfo unitDataConId
        UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId
        AddrRep     -> cgLit LitNullAddr
        VecRep n elem -> do
          platform <- getPlatform
          let elem_lit = mkSimpleLit platform (num_rep_lit (primElemRepToPrimRep elem))
          pure (CmmLit (CmmVec (replicate n elem_lit)))
        prep        -> cgLit (num_rep_lit prep)
        where
          num_rep_lit IntRep    = mkLitIntUnchecked 0
          num_rep_lit Int8Rep   = mkLitInt8Unchecked 0
          num_rep_lit Int16Rep  = mkLitInt16Unchecked 0
          num_rep_lit Int32Rep  = mkLitInt32Unchecked 0
          num_rep_lit Int64Rep  = mkLitInt64Unchecked 0
          num_rep_lit WordRep   = mkLitWordUnchecked 0
          num_rep_lit Word8Rep  = mkLitWord8Unchecked 0
          num_rep_lit Word16Rep = mkLitWord16Unchecked 0
          num_rep_lit Word32Rep = mkLitWord32Unchecked 0
          num_rep_lit Word64Rep = mkLitWord64Unchecked 0
          num_rep_lit FloatRep  = LitFloat 0
          num_rep_lit DoubleRep = LitDouble 0
          num_rep_lit other     = pprPanic "num_rep_lit: Not a num lit" (ppr other)
    cgLit other_lit = do
      platform <- getPlatform
      pure (CmmLit (mkSimpleLit platform other_lit))

    mkSimpleLit :: Platform -> Literal -> CmmLit
    mkSimpleLit platform = \case
       (LitChar   c)                -> CmmInt (fromIntegral (ord c))
                                              (wordWidth platform)
       LitNullAddr                  -> zeroCLit platform
       (LitNumber LitNumInt i)      -> CmmInt i (wordWidth platform)
       (LitNumber LitNumInt8 i)     -> CmmInt i W8
       (LitNumber LitNumInt16 i)    -> CmmInt i W16
       (LitNumber LitNumInt32 i)    -> CmmInt i W32
       (LitNumber LitNumInt64 i)    -> CmmInt i W64
       (LitNumber LitNumWord i)     -> CmmInt i (wordWidth platform)
       (LitNumber LitNumWord8 i)    -> CmmInt i W8
       (LitNumber LitNumWord16 i)   -> CmmInt i W16
       (LitNumber LitNumWord32 i)   -> CmmInt i W32
       (LitNumber LitNumWord64 i)   -> CmmInt i W64
       (LitFloat r)                 -> CmmFloat r W32
       (LitDouble r)                -> CmmFloat r W64
       (LitLabel fs ms fod)
         -> let -- TODO: Literal labels might not actually be in the current package...
                labelSrc = ForeignLabelInThisPackage
            in CmmLabel (mkForeignLabel fs ms labelSrc fod)
       other -> pprPanic "mkSimpleLit" (ppr other)