diff options
Diffstat (limited to 'compiler/GHC/StgToCmm/Lit.hs')
| -rw-r--r-- | compiler/GHC/StgToCmm/Lit.hs | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/compiler/GHC/StgToCmm/Lit.hs b/compiler/GHC/StgToCmm/Lit.hs new file mode 100644 index 0000000000..244a593f9a --- /dev/null +++ b/compiler/GHC/StgToCmm/Lit.hs @@ -0,0 +1,105 @@ +{-# 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) + |