blob: 6a7c37258befb1219dbf0ba881c3fa5fd5c417d1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
{-# 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
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)
|