never executed always true always false
1 {-# LANGUAGE LambdaCase #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Stg to C-- code generation: literals
6 --
7 -- (c) The University of Glasgow 2004-2006
8 --
9 -----------------------------------------------------------------------------
10
11 module GHC.StgToCmm.Lit (
12 cgLit, mkSimpleLit,
13 newStringCLit, newByteStringCLit
14 ) where
15
16 import GHC.Prelude
17
18 import GHC.Platform
19 import GHC.StgToCmm.Monad
20 import GHC.StgToCmm.Env
21 import GHC.Cmm
22 import GHC.Cmm.CLabel
23 import GHC.Cmm.Utils
24
25 import GHC.Types.Literal
26 import GHC.Types.RepType( runtimeRepPrimRep )
27 import GHC.Builtin.Types ( unitDataConId )
28 import GHC.Core.TyCon
29 import GHC.Utils.Misc
30 import GHC.Utils.Outputable
31 import GHC.Utils.Panic
32
33 import Data.ByteString (ByteString)
34 import qualified Data.ByteString.Char8 as BS8
35 import Data.Char (ord)
36
37 newStringCLit :: String -> FCode CmmLit
38 -- ^ Make a global definition for the string,
39 -- and return its label
40 newStringCLit str = newByteStringCLit (BS8.pack str)
41
42 newByteStringCLit :: ByteString -> FCode CmmLit
43 newByteStringCLit bytes
44 = do { uniq <- newUnique
45 ; let (lit, decl) = mkByteStringCLit (mkStringLitLabel uniq) bytes
46 ; emitDecl decl
47 ; return lit }
48
49 cgLit :: Literal -> FCode CmmExpr
50 cgLit (LitString s) =
51 CmmLit <$> newByteStringCLit s
52 -- not unpackFS; we want the UTF-8 byte stream.
53 cgLit (LitRubbish rep) =
54 case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants]
55 VoidRep -> panic "cgLit:VoidRep" -- dito
56 LiftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId
57 UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId
58 AddrRep -> cgLit LitNullAddr
59 VecRep n elem -> do
60 platform <- getPlatform
61 let elem_lit = mkSimpleLit platform (num_rep_lit (primElemRepToPrimRep elem))
62 pure (CmmLit (CmmVec (replicate n elem_lit)))
63 prep -> cgLit (num_rep_lit prep)
64 where
65 prim_reps = runtimeRepPrimRep (text "cgLit") rep
66
67 num_rep_lit IntRep = mkLitIntUnchecked 0
68 num_rep_lit Int8Rep = mkLitInt8Unchecked 0
69 num_rep_lit Int16Rep = mkLitInt16Unchecked 0
70 num_rep_lit Int32Rep = mkLitInt32Unchecked 0
71 num_rep_lit Int64Rep = mkLitInt64Unchecked 0
72 num_rep_lit WordRep = mkLitWordUnchecked 0
73 num_rep_lit Word8Rep = mkLitWord8Unchecked 0
74 num_rep_lit Word16Rep = mkLitWord16Unchecked 0
75 num_rep_lit Word32Rep = mkLitWord32Unchecked 0
76 num_rep_lit Word64Rep = mkLitWord64Unchecked 0
77 num_rep_lit FloatRep = LitFloat 0
78 num_rep_lit DoubleRep = LitDouble 0
79 num_rep_lit other = pprPanic "num_rep_lit: Not a num lit" (ppr other)
80
81 cgLit other_lit = do
82 platform <- getPlatform
83 pure (CmmLit (mkSimpleLit platform other_lit))
84
85 mkSimpleLit :: Platform -> Literal -> CmmLit
86 mkSimpleLit platform = \case
87 (LitChar c) -> CmmInt (fromIntegral (ord c))
88 (wordWidth platform)
89 LitNullAddr -> zeroCLit platform
90 (LitNumber LitNumInt i) -> CmmInt i (wordWidth platform)
91 (LitNumber LitNumInt8 i) -> CmmInt i W8
92 (LitNumber LitNumInt16 i) -> CmmInt i W16
93 (LitNumber LitNumInt32 i) -> CmmInt i W32
94 (LitNumber LitNumInt64 i) -> CmmInt i W64
95 (LitNumber LitNumWord i) -> CmmInt i (wordWidth platform)
96 (LitNumber LitNumWord8 i) -> CmmInt i W8
97 (LitNumber LitNumWord16 i) -> CmmInt i W16
98 (LitNumber LitNumWord32 i) -> CmmInt i W32
99 (LitNumber LitNumWord64 i) -> CmmInt i W64
100 (LitFloat r) -> CmmFloat r W32
101 (LitDouble r) -> CmmFloat r W64
102 (LitLabel fs ms fod)
103 -> let -- TODO: Literal labels might not actually be in the current package...
104 labelSrc = ForeignLabelInThisPackage
105 in CmmLabel (mkForeignLabel fs ms labelSrc fod)
106 other -> pprPanic "mkSimpleLit" (ppr other)
107