Literal.hs 31.5 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1998

Sylvain Henry's avatar
Sylvain Henry committed
5
\section[Literal]{@Literal@: literals}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
9

10
module Literal
11 12 13
        (
        -- * Main data type
          Literal(..)           -- Exported to ParseIface
14
        , LitNumType(..)
15 16

        -- ** Creating Literals
Sylvain Henry's avatar
Sylvain Henry committed
17 18 19 20 21 22
        , mkLitInt, mkLitIntWrap, mkLitIntWrapC
        , mkLitWord, mkLitWordWrap, mkLitWordWrapC
        , mkLitInt64, mkLitInt64Wrap
        , mkLitWord64, mkLitWord64Wrap
        , mkLitFloat, mkLitDouble
        , mkLitChar, mkLitString
23 24
        , mkLitInteger, mkLitNatural
        , mkLitNumber, mkLitNumberWrap
25 26 27

        -- ** Operations on Literals
        , literalType
28
        , absentLiteralOf
29
        , pprLiteral
30 31
        , litNumIsSigned
        , litNumCheckRange
32

33
        -- ** Predicates on Literals and their contents
34
        , litIsDupable, litIsTrivial, litIsLifted
35 36 37
        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
        , isZeroLit
        , litFitsInChar
Sylvain Henry's avatar
Sylvain Henry committed
38
        , litValue, isLitValue, isLitValue_maybe, mapLitValue
39

40
        -- ** Coercions
41
        , word2IntLit, int2WordLit
42
        , narrowLit
43 44 45 46
        , narrow8IntLit, narrow16IntLit, narrow32IntLit
        , narrow8WordLit, narrow16WordLit, narrow32WordLit
        , char2IntLit, int2CharLit
        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
47
        , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit
48
        ) where
49

Ian Lynagh's avatar
Ian Lynagh committed
50 51
#include "HsVersions.h"

52 53
import GhcPrelude

Simon Marlow's avatar
Simon Marlow committed
54
import TysPrim
55
import PrelNames
Simon Marlow's avatar
Simon Marlow committed
56
import Type
57
import TyCon
58
import Outputable
59
import FastString
60
import BasicTypes
61
import Binary
62
import Constants
63
import DynFlags
John Ericson's avatar
John Ericson committed
64
import GHC.Platform
65
import UniqFM
66 67
import Util

68
import Data.ByteString (ByteString)
Simon Marlow's avatar
Simon Marlow committed
69 70 71
import Data.Int
import Data.Word
import Data.Char
Sylvain Henry's avatar
Sylvain Henry committed
72
import Data.Maybe ( isJust )
73
import Data.Data ( Data )
74
import Data.Proxy
75
import Numeric ( fromRat )
76

Austin Seipp's avatar
Austin Seipp committed
77 78 79
{-
************************************************************************
*                                                                      *
80
\subsection{Literals}
Austin Seipp's avatar
Austin Seipp committed
81 82 83
*                                                                      *
************************************************************************
-}
84

85 86
-- | So-called 'Literal's are one of:
--
Sylvain Henry's avatar
Sylvain Henry committed
87 88 89
-- * An unboxed numeric literal or floating-point literal which is presumed
--   to be surrounded by appropriate constructors (@Int#@, etc.), so that
--   the overall thing makes sense.
90
--
Sylvain Henry's avatar
Sylvain Henry committed
91 92 93
--   We maintain the invariant that the 'Integer' in the 'LitNumber'
--   constructor is actually in the (possibly target-dependent) range.
--   The mkLit{Int,Word}*Wrap smart constructors ensure this by applying
94 95 96
--   the target machine's wrapping semantics. Use these in situations
--   where you know the wrapping semantics are correct.
--
97
-- * The literal derived from the label mentioned in a \"foreign label\"
Sylvain Henry's avatar
Sylvain Henry committed
98
--   declaration ('LitLabel')
99
--
Sylvain Henry's avatar
Sylvain Henry committed
100
-- * A 'LitRubbish' to be used in place of values of 'UnliftedRep'
101
--   (i.e. 'MutVar#') when the the value is never used.
Sylvain Henry's avatar
Sylvain Henry committed
102 103 104 105 106
--
-- * A character
-- * A string
-- * The NULL pointer
--
107
data Literal
Sylvain Henry's avatar
Sylvain Henry committed
108 109
  = LitChar    Char             -- ^ @Char#@ - at least 31 bits. Create with
                                -- 'mkLitChar'
110

111
  | LitNumber !LitNumType !Integer Type
Sylvain Henry's avatar
Sylvain Henry committed
112
                                -- ^ Any numeric literal that can be
113 114 115
                                -- internally represented with an Integer.
                                -- See Note [Types of LitNumbers] below for the
                                -- Type field.
116

Sylvain Henry's avatar
Sylvain Henry committed
117
  | LitString  ByteString       -- ^ A string-literal: stored and emitted
118
                                -- UTF-8 encoded, we'll arrange to decode it
119
                                -- at runtime.  Also emitted with a @\'\\0\'@
Sylvain Henry's avatar
Sylvain Henry committed
120
                                -- terminator. Create with 'mkLitString'
121

Sylvain Henry's avatar
Sylvain Henry committed
122
  | LitNullAddr                 -- ^ The @NULL@ pointer, the only pointer value
123
                                -- that can be represented as a Literal. Create
124 125
                                -- with 'nullAddrLit'

Sylvain Henry's avatar
Sylvain Henry committed
126
  | LitRubbish                  -- ^ A nonsense value, used when an unlifted
127 128 129
                                -- binding is absent and has type
                                -- @forall (a :: 'TYPE' 'UnliftedRep'). a@.
                                -- May be lowered by code-gen to any possible
Sylvain Henry's avatar
Sylvain Henry committed
130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
                                -- value. Also see Note [Rubbish literals]

  | LitFloat   Rational         -- ^ @Float#@. Create with 'mkLitFloat'
  | LitDouble  Rational         -- ^ @Double#@. Create with 'mkLitDouble'

  | LitLabel   FastString (Maybe Int) FunctionOrData
                                -- ^ A label literal. Parameters:
                                --
                                -- 1) The name of the symbol mentioned in the
                                --    declaration
                                --
                                -- 2) The size (in bytes) of the arguments
                                --    the label expects. Only applicable with
                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
                                --    be appended to label name when emitting
                                --    assembly.
                                --
                                -- 3) Flag indicating whether the symbol
                                --    references a function or a data
149
  deriving Data
150

151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
-- | Numeric literal type
data LitNumType
  = LitNumInteger -- ^ @Integer@ (see Note [Integer literals])
  | LitNumNatural -- ^ @Natural@ (see Note [Natural literals])
  | LitNumInt     -- ^ @Int#@ - according to target machine
  | LitNumInt64   -- ^ @Int64#@ - exactly 64 bits
  | LitNumWord    -- ^ @Word#@ - according to target machine
  | LitNumWord64  -- ^ @Word64#@ - exactly 64 bits
  deriving (Data,Enum,Eq,Ord)

-- | Indicate if a numeric literal type supports negative numbers
litNumIsSigned :: LitNumType -> Bool
litNumIsSigned nt = case nt of
  LitNumInteger -> True
  LitNumNatural -> False
  LitNumInt     -> True
  LitNumInt64   -> True
  LitNumWord    -> False
  LitNumWord64  -> False

Austin Seipp's avatar
Austin Seipp committed
171
{-
172 173 174
Note [Integer literals]
~~~~~~~~~~~~~~~~~~~~~~~
An Integer literal is represented using, well, an Integer, to make it
175 176
easier to write RULEs for them. They also contain the Integer type, so
that e.g. literalType can return the right Type for them.
177

178 179 180 181
They only get converted into real Core,
    mkInteger [c1, c2, .., cn]
during the CorePrep phase, although TidyPgm looks ahead at what the
core will be, so that it can see whether it involves CAFs.
182

183
When we initially build an Integer literal, notably when
184 185 186 187
deserialising it from an interface file (see the Binary instance
below), we don't have convenient access to the mkInteger Id.  So we
just use an error thunk, and fill in the real Id when we do tcIfaceLit
in TcIface.
188

189 190 191
Note [Natural literals]
~~~~~~~~~~~~~~~~~~~~~~~
Similar to Integer literals.
192

193 194 195 196 197 198 199 200 201 202 203 204 205 206
Note [String literals]
~~~~~~~~~~~~~~~~~~~~~~

String literals are UTF-8 encoded and stored into ByteStrings in the following
ASTs: Haskell, Core, Stg, Cmm. TH can also emit ByteString based string literals
with the BytesPrimL constructor (see #14741).

It wasn't true before as [Word8] was used in Cmm AST and in TH which was quite
bad for performance with large strings (see #16198 and #14741).

To include string literals into output objects, the assembler code generator has
to embed the UTF-8 encoded binary blob. See Note [Embedding large binary blobs]
for more details.

Austin Seipp's avatar
Austin Seipp committed
207
-}
208

209 210 211 212 213 214
instance Binary LitNumType where
   put_ bh numTyp = putByte bh (fromIntegral (fromEnum numTyp))
   get bh = do
      h <- getByte bh
      return (toEnum (fromIntegral h))

215
instance Binary Literal where
Sylvain Henry's avatar
Sylvain Henry committed
216 217 218 219 220 221
    put_ bh (LitChar aa)     = do putByte bh 0; put_ bh aa
    put_ bh (LitString ab)   = do putByte bh 1; put_ bh ab
    put_ bh (LitNullAddr)    = do putByte bh 2
    put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah
    put_ bh (LitDouble ai)   = do putByte bh 4; put_ bh ai
    put_ bh (LitLabel aj mb fod)
222
        = do putByte bh 5
223 224 225
             put_ bh aj
             put_ bh mb
             put_ bh fod
226 227 228 229
    put_ bh (LitNumber nt i _)
        = do putByte bh 6
             put_ bh nt
             put_ bh i
Sylvain Henry's avatar
Sylvain Henry committed
230
    put_ bh (LitRubbish)     = do putByte bh 7
231
    get bh = do
232 233 234 235
            h <- getByte bh
            case h of
              0 -> do
                    aa <- get bh
Sylvain Henry's avatar
Sylvain Henry committed
236
                    return (LitChar aa)
237 238
              1 -> do
                    ab <- get bh
Sylvain Henry's avatar
Sylvain Henry committed
239
                    return (LitString ab)
240
              2 -> do
Sylvain Henry's avatar
Sylvain Henry committed
241
                    return (LitNullAddr)
242 243
              3 -> do
                    ah <- get bh
Sylvain Henry's avatar
Sylvain Henry committed
244
                    return (LitFloat ah)
245
              4 -> do
246
                    ai <- get bh
Sylvain Henry's avatar
Sylvain Henry committed
247
                    return (LitDouble ai)
248
              5 -> do
249 250 251
                    aj <- get bh
                    mb <- get bh
                    fod <- get bh
Sylvain Henry's avatar
Sylvain Henry committed
252
                    return (LitLabel aj mb fod)
253
              6 -> do
254 255
                    nt <- get bh
                    i  <- get bh
256
                    -- Note [Types of LitNumbers]
257 258 259 260 261 262 263 264 265 266 267 268
                    let t = case nt of
                            LitNumInt     -> intPrimTy
                            LitNumInt64   -> int64PrimTy
                            LitNumWord    -> wordPrimTy
                            LitNumWord64  -> word64PrimTy
                            -- See Note [Integer literals]
                            LitNumInteger ->
                              panic "Evaluated the place holder for mkInteger"
                            -- and Note [Natural literals]
                            LitNumNatural ->
                              panic "Evaluated the place holder for mkNatural"
                    return (LitNumber nt i t)
269
              _ -> do
Sylvain Henry's avatar
Sylvain Henry committed
270
                    return (LitRubbish)
271

272
instance Outputable Literal where
273
    ppr = pprLiteral id
274 275

instance Eq Literal where
276
    a == b = compare a b == EQ
277

278 279
-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in
-- 'TrieMap.CoreMap'.
280
instance Ord Literal where
281
    compare = cmpLit
282

Austin Seipp's avatar
Austin Seipp committed
283
{-
284 285
        Construction
        ~~~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
286 287
-}

288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305
{- Note [Word/Int underflow/overflow]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
According to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and
unsigned integral types): "All arithmetic is performed modulo 2^n, where n is
the number of bits in the type."

GHC stores Word# and Int# constant values as Integer. Core optimizations such
as constant folding must ensure that the Integer value remains in the valid
target Word/Int range (see #13172). The following functions are used to
ensure this.

Note that we *don't* warn the user about overflow. It's not done at runtime
either, and compilation of completely harmless things like
   ((124076834 :: Word32) + (2147483647 :: Word32))
doesn't yield a warning. Instead we simply squash the value into the *target*
Int/Word range.
-}

306 307 308 309
-- | Wrap a literal number according to its type
wrapLitNumber :: DynFlags -> Literal -> Literal
wrapLitNumber dflags v@(LitNumber nt i t) = case nt of
  LitNumInt -> case platformWordSize (targetPlatform dflags) of
310 311
    PW4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t
    PW8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t
312
  LitNumWord -> case platformWordSize (targetPlatform dflags) of
313 314
    PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t
    PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t
315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340
  LitNumInt64   -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t
  LitNumWord64  -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t
  LitNumInteger -> v
  LitNumNatural -> v
wrapLitNumber _ x = x

-- | Create a numeric 'Literal' of the given type
mkLitNumberWrap :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumberWrap dflags nt i t = wrapLitNumber dflags (LitNumber nt i t)

-- | Check that a given number is in the range of a numeric literal
litNumCheckRange :: DynFlags -> LitNumType -> Integer -> Bool
litNumCheckRange dflags nt i = case nt of
     LitNumInt     -> inIntRange dflags i
     LitNumWord    -> inWordRange dflags i
     LitNumInt64   -> inInt64Range i
     LitNumWord64  -> inWord64Range i
     LitNumNatural -> i >= 0
     LitNumInteger -> True

-- | Create a numeric 'Literal' of the given type
mkLitNumber :: DynFlags -> LitNumType -> Integer -> Type -> Literal
mkLitNumber dflags nt i t =
  ASSERT2(litNumCheckRange dflags nt i, integer i)
  (LitNumber nt i t)

341
-- | Creates a 'Literal' of type @Int#@
Sylvain Henry's avatar
Sylvain Henry committed
342 343 344
mkLitInt :: DynFlags -> Integer -> Literal
mkLitInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
                       (mkLitIntUnchecked x)
345

346 347
-- | Creates a 'Literal' of type @Int#@.
--   If the argument is out of the (target-dependent) range, it is wrapped.
348
--   See Note [Word/Int underflow/overflow]
Sylvain Henry's avatar
Sylvain Henry committed
349 350
mkLitIntWrap :: DynFlags -> Integer -> Literal
mkLitIntWrap dflags i = wrapLitNumber dflags $ mkLitIntUnchecked i
351 352

-- | Creates a 'Literal' of type @Int#@ without checking its range.
Sylvain Henry's avatar
Sylvain Henry committed
353 354
mkLitIntUnchecked :: Integer -> Literal
mkLitIntUnchecked i = LitNumber LitNumInt i intPrimTy
355 356 357 358 359

-- | Creates a 'Literal' of type @Int#@, as well as a 'Bool'ean flag indicating
--   overflow. That is, if the argument is out of the (target-dependent) range
--   the argument is wrapped and the overflow flag will be set.
--   See Note [Word/Int underflow/overflow]
Sylvain Henry's avatar
Sylvain Henry committed
360 361
mkLitIntWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitIntWrapC dflags i = (n, i /= i')
362
  where
Sylvain Henry's avatar
Sylvain Henry committed
363
    n@(LitNumber _ i' _) = mkLitIntWrap dflags i
364

365
-- | Creates a 'Literal' of type @Word#@
Sylvain Henry's avatar
Sylvain Henry committed
366 367 368
mkLitWord :: DynFlags -> Integer -> Literal
mkLitWord dflags x   = ASSERT2( inWordRange dflags x, integer x )
                        (mkLitWordUnchecked x)
369

370 371
-- | Creates a 'Literal' of type @Word#@.
--   If the argument is out of the (target-dependent) range, it is wrapped.
372
--   See Note [Word/Int underflow/overflow]
Sylvain Henry's avatar
Sylvain Henry committed
373 374
mkLitWordWrap :: DynFlags -> Integer -> Literal
mkLitWordWrap dflags i = wrapLitNumber dflags $ mkLitWordUnchecked i
375 376

-- | Creates a 'Literal' of type @Word#@ without checking its range.
Sylvain Henry's avatar
Sylvain Henry committed
377 378
mkLitWordUnchecked :: Integer -> Literal
mkLitWordUnchecked i = LitNumber LitNumWord i wordPrimTy
379 380 381 382 383

-- | Creates a 'Literal' of type @Word#@, as well as a 'Bool'ean flag indicating
--   carry. That is, if the argument is out of the (target-dependent) range
--   the argument is wrapped and the carry flag will be set.
--   See Note [Word/Int underflow/overflow]
Sylvain Henry's avatar
Sylvain Henry committed
384 385
mkLitWordWrapC :: DynFlags -> Integer -> (Literal, Bool)
mkLitWordWrapC dflags i = (n, i /= i')
386
  where
Sylvain Henry's avatar
Sylvain Henry committed
387
    n@(LitNumber _ i' _) = mkLitWordWrap dflags i
388

389
-- | Creates a 'Literal' of type @Int64#@
Sylvain Henry's avatar
Sylvain Henry committed
390 391
mkLitInt64 :: Integer -> Literal
mkLitInt64  x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)
392 393 394

-- | Creates a 'Literal' of type @Int64#@.
--   If the argument is out of the range, it is wrapped.
Sylvain Henry's avatar
Sylvain Henry committed
395 396
mkLitInt64Wrap :: DynFlags -> Integer -> Literal
mkLitInt64Wrap dflags i = wrapLitNumber dflags $ mkLitInt64Unchecked i
397 398

-- | Creates a 'Literal' of type @Int64#@ without checking its range.
Sylvain Henry's avatar
Sylvain Henry committed
399 400
mkLitInt64Unchecked :: Integer -> Literal
mkLitInt64Unchecked i = LitNumber LitNumInt64 i int64PrimTy
401 402

-- | Creates a 'Literal' of type @Word64#@
Sylvain Henry's avatar
Sylvain Henry committed
403 404
mkLitWord64 :: Integer -> Literal
mkLitWord64 x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)
405 406 407

-- | Creates a 'Literal' of type @Word64#@.
--   If the argument is out of the range, it is wrapped.
Sylvain Henry's avatar
Sylvain Henry committed
408 409
mkLitWord64Wrap :: DynFlags -> Integer -> Literal
mkLitWord64Wrap dflags i = wrapLitNumber dflags $ mkLitWord64Unchecked i
410 411

-- | Creates a 'Literal' of type @Word64#@ without checking its range.
Sylvain Henry's avatar
Sylvain Henry committed
412 413
mkLitWord64Unchecked :: Integer -> Literal
mkLitWord64Unchecked i = LitNumber LitNumWord64 i word64PrimTy
414

415
-- | Creates a 'Literal' of type @Float#@
Sylvain Henry's avatar
Sylvain Henry committed
416 417
mkLitFloat :: Rational -> Literal
mkLitFloat = LitFloat
418 419

-- | Creates a 'Literal' of type @Double#@
Sylvain Henry's avatar
Sylvain Henry committed
420 421
mkLitDouble :: Rational -> Literal
mkLitDouble = LitDouble
422 423

-- | Creates a 'Literal' of type @Char#@
Sylvain Henry's avatar
Sylvain Henry committed
424 425
mkLitChar :: Char -> Literal
mkLitChar = LitChar
426 427 428

-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
Sylvain Henry's avatar
Sylvain Henry committed
429
mkLitString :: String -> Literal
430
-- stored UTF-8 encoded
431
mkLitString s = LitString (bytesFS $ mkFastString s)
432

433
mkLitInteger :: Integer -> Type -> Literal
434 435 436 437 438
mkLitInteger x ty = LitNumber LitNumInteger x ty

mkLitNatural :: Integer -> Type -> Literal
mkLitNatural x ty = ASSERT2( inNaturalRange x,  integer x )
                    (LitNumber LitNumNatural x ty)
439

440 441 442
inIntRange, inWordRange :: DynFlags -> Integer -> Bool
inIntRange  dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags
inWordRange dflags x = x >= 0                     && x <= tARGET_MAX_WORD dflags
443

444 445 446
inNaturalRange :: Integer -> Bool
inNaturalRange x = x >= 0

447 448 449 450 451 452
inInt64Range, inWord64Range :: Integer -> Bool
inInt64Range x  = x >= toInteger (minBound :: Int64) &&
                  x <= toInteger (maxBound :: Int64)
inWord64Range x = x >= toInteger (minBound :: Word64) &&
                  x <= toInteger (maxBound :: Word64)

453 454
inCharRange :: Char -> Bool
inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
455

456
-- | Tests whether the literal represents a zero of whatever type it is
457
isZeroLit :: Literal -> Bool
458
isZeroLit (LitNumber _ 0 _) = True
Sylvain Henry's avatar
Sylvain Henry committed
459 460
isZeroLit (LitFloat  0)     = True
isZeroLit (LitDouble 0)     = True
461
isZeroLit _                 = False
462

463
-- | Returns the 'Integer' contained in the 'Literal', for when that makes
464
-- sense, i.e. for 'Char', 'Int', 'Word', 'LitInteger' and 'LitNatural'.
465
litValue  :: Literal -> Integer
Sylvain Henry's avatar
Sylvain Henry committed
466 467 468 469 470
litValue l = case isLitValue_maybe l of
   Just x  -> x
   Nothing -> pprPanic "litValue" (ppr l)

-- | Returns the 'Integer' contained in the 'Literal', for when that makes
471
-- sense, i.e. for 'Char' and numbers.
Sylvain Henry's avatar
Sylvain Henry committed
472
isLitValue_maybe  :: Literal -> Maybe Integer
Sylvain Henry's avatar
Sylvain Henry committed
473
isLitValue_maybe (LitChar   c)     = Just $ toInteger $ ord c
474 475
isLitValue_maybe (LitNumber _ i _) = Just i
isLitValue_maybe _                 = Nothing
Sylvain Henry's avatar
Sylvain Henry committed
476 477

-- | Apply a function to the 'Integer' contained in the 'Literal', for when that
478 479 480
-- makes sense, e.g. for 'Char' and numbers.
-- For fixed-size integral literals, the result will be wrapped in accordance
-- with the semantics of the target type.
481
-- See Note [Word/Int underflow/overflow]
482
mapLitValue  :: DynFlags -> (Integer -> Integer) -> Literal -> Literal
Sylvain Henry's avatar
Sylvain Henry committed
483
mapLitValue _      f (LitChar   c)      = mkLitChar (fchar c)
Sylvain Henry's avatar
Sylvain Henry committed
484
   where fchar = chr . fromInteger . f . toInteger . ord
485 486 487
mapLitValue dflags f (LitNumber nt i t) = wrapLitNumber dflags
                                                        (LitNumber nt (f i) t)
mapLitValue _      _ l                  = pprPanic "mapLitValue" (ppr l)
Sylvain Henry's avatar
Sylvain Henry committed
488 489

-- | Indicate if the `Literal` contains an 'Integer' value, e.g. 'Char',
490
-- 'Int', 'Word', 'LitInteger' and 'LitNatural'.
Sylvain Henry's avatar
Sylvain Henry committed
491 492
isLitValue  :: Literal -> Bool
isLitValue = isJust . isLitValue_maybe
493

Austin Seipp's avatar
Austin Seipp committed
494
{-
495 496
        Coercions
        ~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
497 498
-}

499
narrow8IntLit, narrow16IntLit, narrow32IntLit,
apt's avatar
apt committed
500
  narrow8WordLit, narrow16WordLit, narrow32WordLit,
501 502
  char2IntLit, int2CharLit,
  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
apt's avatar
apt committed
503
  float2DoubleLit, double2FloatLit
504
  :: Literal -> Literal
505

506
word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
507
word2IntLit dflags (LitNumber LitNumWord w _)
Sylvain Henry's avatar
Sylvain Henry committed
508 509 510 511 512
  -- Map Word range [max_int+1, max_word]
  -- to Int range   [min_int  , -1]
  -- Range [0,max_int] has the same representation with both Int and Word
  | w > tARGET_MAX_INT dflags = mkLitInt dflags (w - tARGET_MAX_WORD dflags - 1)
  | otherwise                 = mkLitInt dflags w
513
word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
514

515
int2WordLit dflags (LitNumber LitNumInt i _)
Sylvain Henry's avatar
Sylvain Henry committed
516 517 518 519 520
  -- Map Int range [min_int  , -1]
  -- to Word range [max_int+1, max_word]
  -- Range [0,max_int] has the same representation with both Int and Word
  | i < 0     = mkLitWord dflags (1 + tARGET_MAX_WORD dflags + i)
  | otherwise = mkLitWord dflags i
521
int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
522

523 524 525 526 527 528 529 530 531 532 533 534
-- | Narrow a literal number (unchecked result range)
narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal
narrowLit _ (LitNumber nt i t) = LitNumber nt (toInteger (fromInteger i :: a)) t
narrowLit _ l                  = pprPanic "narrowLit" (ppr l)

narrow8IntLit   = narrowLit (Proxy :: Proxy Int8)
narrow16IntLit  = narrowLit (Proxy :: Proxy Int16)
narrow32IntLit  = narrowLit (Proxy :: Proxy Int32)
narrow8WordLit  = narrowLit (Proxy :: Proxy Word8)
narrow16WordLit = narrowLit (Proxy :: Proxy Word16)
narrow32WordLit = narrowLit (Proxy :: Proxy Word32)

Sylvain Henry's avatar
Sylvain Henry committed
535 536 537
char2IntLit (LitChar c)       = mkLitIntUnchecked (toInteger (ord c))
char2IntLit l                 = pprPanic "char2IntLit" (ppr l)
int2CharLit (LitNumber _ i _) = LitChar (chr (fromInteger i))
538
int2CharLit l                 = pprPanic "int2CharLit" (ppr l)
539

Sylvain Henry's avatar
Sylvain Henry committed
540 541 542
float2IntLit (LitFloat f)      = mkLitIntUnchecked (truncate f)
float2IntLit l                 = pprPanic "float2IntLit" (ppr l)
int2FloatLit (LitNumber _ i _) = LitFloat (fromInteger i)
543
int2FloatLit l                 = pprPanic "int2FloatLit" (ppr l)
544

Sylvain Henry's avatar
Sylvain Henry committed
545 546 547
double2IntLit (LitDouble f)     = mkLitIntUnchecked (truncate f)
double2IntLit l                 = pprPanic "double2IntLit" (ppr l)
int2DoubleLit (LitNumber _ i _) = LitDouble (fromInteger i)
548
int2DoubleLit l                 = pprPanic "int2DoubleLit" (ppr l)
549

Sylvain Henry's avatar
Sylvain Henry committed
550 551 552 553
float2DoubleLit (LitFloat  f) = LitDouble f
float2DoubleLit l             = pprPanic "float2DoubleLit" (ppr l)
double2FloatLit (LitDouble d) = LitFloat  d
double2FloatLit l             = pprPanic "double2FloatLit" (ppr l)
apt's avatar
apt committed
554 555

nullAddrLit :: Literal
Sylvain Henry's avatar
Sylvain Henry committed
556
nullAddrLit = LitNullAddr
557

558 559
-- | A nonsense literal of type @forall (a :: 'TYPE' 'UnliftedRep'). a@.
rubbishLit :: Literal
Sylvain Henry's avatar
Sylvain Henry committed
560
rubbishLit = LitRubbish
561

Austin Seipp's avatar
Austin Seipp committed
562
{-
563 564
        Predicates
        ~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
565 566
-}

567
-- | True if there is absolutely no penalty to duplicating the literal.
568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599
-- False principally of strings.
--
-- "Why?", you say? I'm glad you asked. Well, for one duplicating strings would
-- blow up code sizes. Not only this, it's also unsafe.
--
-- Consider a program that wants to traverse a string. One way it might do this
-- is to first compute the Addr# pointing to the end of the string, and then,
-- starting from the beginning, bump a pointer using eqAddr# to determine the
-- end. For instance,
--
-- @
-- -- Given pointers to the start and end of a string, count how many zeros
-- -- the string contains.
-- countZeros :: Addr# -> Addr# -> -> Int
-- countZeros start end = go start 0
--   where
--     go off n
--       | off `addrEq#` end = n
--       | otherwise         = go (off `plusAddr#` 1) n'
--       where n' | isTrue# (indexInt8OffAddr# off 0# ==# 0#) = n + 1
--                | otherwise                                 = n
-- @
--
-- Consider what happens if we considered strings to be trivial (and therefore
-- duplicable) and emitted a call like @countZeros "hello"# ("hello"#
-- `plusAddr`# 5)@. The beginning and end pointers do not belong to the same
-- string, meaning that an iteration like the above would blow up terribly.
-- This is what happened in #12757.
--
-- Ultimately the solution here is to make primitive strings a bit more
-- structured, ensuring that the compiler can't inline in ways that will break
-- user code. One approach to this is described in #8472.
600
litIsTrivial :: Literal -> Bool
601
--      c.f. CoreUtils.exprIsTrivial
Sylvain Henry's avatar
Sylvain Henry committed
602
litIsTrivial (LitString _)      = False
603 604 605 606 607 608 609
litIsTrivial (LitNumber nt _ _) = case nt of
  LitNumInteger -> False
  LitNumNatural -> False
  LitNumInt     -> True
  LitNumInt64   -> True
  LitNumWord    -> True
  LitNumWord64  -> True
Sylvain Henry's avatar
Sylvain Henry committed
610
litIsTrivial _                  = True
611

612
-- | True if code space does not go bad if we duplicate this literal
613
litIsDupable :: DynFlags -> Literal -> Bool
614
--      c.f. CoreUtils.exprIsDupable
Sylvain Henry's avatar
Sylvain Henry committed
615
litIsDupable _      (LitString _)      = False
616 617 618 619 620 621 622
litIsDupable dflags (LitNumber nt i _) = case nt of
  LitNumInteger -> inIntRange dflags i
  LitNumNatural -> inIntRange dflags i
  LitNumInt     -> True
  LitNumInt64   -> True
  LitNumWord    -> True
  LitNumWord64  -> True
Sylvain Henry's avatar
Sylvain Henry committed
623
litIsDupable _      _                  = True
624

625
litFitsInChar :: Literal -> Bool
626 627 628
litFitsInChar (LitNumber _ i _) = i >= toInteger (ord minBound)
                               && i <= toInteger (ord maxBound)
litFitsInChar _                 = False
629 630

litIsLifted :: Literal -> Bool
631 632 633 634 635 636 637
litIsLifted (LitNumber nt _ _) = case nt of
  LitNumInteger -> True
  LitNumNatural -> True
  LitNumInt     -> False
  LitNumInt64   -> False
  LitNumWord    -> False
  LitNumWord64  -> False
Sylvain Henry's avatar
Sylvain Henry committed
638
litIsLifted _                  = False
639

Austin Seipp's avatar
Austin Seipp committed
640
{-
641 642
        Types
        ~~~~~
643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662

Note [Types of LitNumbers]
~~~~~~~~~~~~~~~~~~~~~~~~~~

A LitNumber's type is always known from its LitNumType:

  LitNumInteger -> Integer
  LitNumNatural -> Natural
  LitNumInt     -> Int# (intPrimTy)
  LitNumInt64   -> Int64# (int64PrimTy)
  LitNumWord    -> Word# (wordPrimTy)
  LitNumWord64  -> Word64# (word64PrimTy)

The reason why we have a Type field is because Integer and Natural types live
outside of GHC (in the libraries), so we have to get the actual Type via
lookupTyCon, tcIfaceTyConByName etc. that's too inconvenient in the call sites
of literalType, so we do that when creating these literals, and literalType
simply reads the field.

(But see also Note [Integer literals] and Note [Natural literals])
Austin Seipp's avatar
Austin Seipp committed
663 664
-}

665
-- | Find the Haskell 'Type' the literal occupies
666
literalType :: Literal -> Type
Sylvain Henry's avatar
Sylvain Henry committed
667 668 669 670 671 672
literalType LitNullAddr       = addrPrimTy
literalType (LitChar _)       = charPrimTy
literalType (LitString  _)    = addrPrimTy
literalType (LitFloat _)      = floatPrimTy
literalType (LitDouble _)     = doublePrimTy
literalType (LitLabel _ _ _)  = addrPrimTy
673
literalType (LitNumber _ _ t) = t -- Note [Types of LitNumbers]
Sylvain Henry's avatar
Sylvain Henry committed
674
literalType (LitRubbish)      = mkForAllTy a Inferred (mkTyVarTy a)
675 676
  where
    a = alphaTyVarUnliftedRep
677 678

absentLiteralOf :: TyCon -> Maybe Literal
679
-- Return a literal of the appropriate primitive
680
-- TyCon, to use as a placeholder when it doesn't matter
Sylvain Henry's avatar
Sylvain Henry committed
681
-- Rubbish literals are handled in WwLib, because
682 683
--  1. Looking at the TyCon is not enough, we need the actual type
--  2. This would need to return a type application to a literal
684 685 686
absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)

absent_lits :: UniqFM Literal
Sylvain Henry's avatar
Sylvain Henry committed
687 688 689 690 691 692 693 694
absent_lits = listToUFM [ (addrPrimTyConKey,    LitNullAddr)
                        , (charPrimTyConKey,    LitChar 'x')
                        , (intPrimTyConKey,     mkLitIntUnchecked 0)
                        , (int64PrimTyConKey,   mkLitInt64Unchecked 0)
                        , (wordPrimTyConKey,    mkLitWordUnchecked 0)
                        , (word64PrimTyConKey,  mkLitWord64Unchecked 0)
                        , (floatPrimTyConKey,   LitFloat 0)
                        , (doublePrimTyConKey,  LitDouble 0)
695
                        ]
696

Austin Seipp's avatar
Austin Seipp committed
697
{-
698 699
        Comparison
        ~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
700 701
-}

702
cmpLit :: Literal -> Literal -> Ordering
Sylvain Henry's avatar
Sylvain Henry committed
703 704 705 706 707 708 709
cmpLit (LitChar      a)     (LitChar       b)     = a `compare` b
cmpLit (LitString    a)     (LitString     b)     = a `compare` b
cmpLit (LitNullAddr)        (LitNullAddr)         = EQ
cmpLit (LitFloat     a)     (LitFloat      b)     = a `compare` b
cmpLit (LitDouble    a)     (LitDouble     b)     = a `compare` b
cmpLit (LitLabel     a _ _) (LitLabel      b _ _) = a `compare` b
cmpLit (LitNumber nt1 a _)  (LitNumber nt2  b _)
710 711
  | nt1 == nt2 = a   `compare` b
  | otherwise  = nt1 `compare` nt2
Sylvain Henry's avatar
Sylvain Henry committed
712
cmpLit (LitRubbish)         (LitRubbish)          = EQ
713 714 715
cmpLit lit1 lit2
  | litTag lit1 < litTag lit2 = LT
  | otherwise                 = GT
716 717

litTag :: Literal -> Int
Sylvain Henry's avatar
Sylvain Henry committed
718 719 720 721 722 723 724 725
litTag (LitChar      _)   = 1
litTag (LitString    _)   = 2
litTag (LitNullAddr)      = 3
litTag (LitFloat     _)   = 4
litTag (LitDouble    _)   = 5
litTag (LitLabel _ _ _)   = 6
litTag (LitNumber  {})    = 7
litTag (LitRubbish)       = 8
726

Austin Seipp's avatar
Austin Seipp committed
727
{-
728 729
        Printing
        ~~~~~~~~
730
* See Note [Printing of literals in Core]
Austin Seipp's avatar
Austin Seipp committed
731
-}
732

733
pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
Sylvain Henry's avatar
Sylvain Henry committed
734 735 736 737 738
pprLiteral _       (LitChar c)     = pprPrimChar c
pprLiteral _       (LitString s)   = pprHsBytes s
pprLiteral _       (LitNullAddr)   = text "__NULL"
pprLiteral _       (LitFloat f)    = float (fromRat f) <> primFloatSuffix
pprLiteral _       (LitDouble d)   = double (fromRat d) <> primDoubleSuffix
739 740 741 742 743 744 745 746
pprLiteral add_par (LitNumber nt i _)
   = case nt of
       LitNumInteger -> pprIntegerVal add_par i
       LitNumNatural -> pprIntegerVal add_par i
       LitNumInt     -> pprPrimInt i
       LitNumInt64   -> pprPrimInt64 i
       LitNumWord    -> pprPrimWord i
       LitNumWord64  -> pprPrimWord64 i
Sylvain Henry's avatar
Sylvain Henry committed
747 748
pprLiteral add_par (LitLabel l mb fod) =
    add_par (text "__label" <+> b <+> ppr fod)
749 750 751
    where b = case mb of
              Nothing -> pprHsString l
              Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
Sylvain Henry's avatar
Sylvain Henry committed
752
pprLiteral _       (LitRubbish)     = text "__RUBBISH"
753

754 755 756 757 758 759 760 761 762
pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
-- See Note [Printing of literals in Core].
pprIntegerVal add_par i | i < 0     = add_par (integer i)
                        | otherwise = integer i

{-
Note [Printing of literals in Core]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The function `add_par` is used to wrap parenthesis around negative integers
Sylvain Henry's avatar
Sylvain Henry committed
763
(`LitInteger`) and labels (`LitLabel`), if they occur in a context requiring
764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782
an atomic thing (for example function application).

Although not all Core literals would be valid Haskell, we are trying to stay
as close as possible to Haskell syntax in the printing of Core, to make it
easier for a Haskell user to read Core.

To that end:
  * We do print parenthesis around negative `LitInteger`, because we print
  `LitInteger` using plain number literals (no prefix or suffix), and plain
  number literals in Haskell require parenthesis in contexts like function
  application (i.e. `1 - -1` is not valid Haskell).

  * We don't print parenthesis around other (negative) literals, because they
  aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's
  parser).

Literal         Output             Output if context requires
                                   an atom (if different)
-------         -------            ----------------------
Sylvain Henry's avatar
Sylvain Henry committed
783 784 785 786 787 788 789 790 791
LitChar         'a'#
LitString       "aaa"#
LitNullAddr     "__NULL"
LitInt          -1#
LitInt64        -1L#
LitWord          1##
LitWord64        1L##
LitFloat        -1.0#
LitDouble       -1.0##
792
LitInteger      -1                 (-1)
Sylvain Henry's avatar
Sylvain Henry committed
793 794
LitLabel        "__label" ...      ("__label" ...)
LitRubbish      "__RUBBISH"
795

Sylvain Henry's avatar
Sylvain Henry committed
796 797
Note [Rubbish literals]
~~~~~~~~~~~~~~~~~~~~~~~
798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818
During worker/wrapper after demand analysis, where an argument
is unused (absent) we do the following w/w split (supposing that
y is absent):

  f x y z = e
===>
  f x y z = $wf x z
  $wf x z = let y = <absent value>
            in e

Usually the binding for y is ultimately optimised away, and
even if not it should never be evaluated -- but that's the
way the w/w split starts off.

What is <absent value>?
* For lifted values <absent value> can be a call to 'error'.
* For primitive types like Int# or Word# we can use any random
  value of that type.
* But what about /unlifted/ but /boxed/ types like MutVar# or
  Array#?   We need a literal value of that type.

Sylvain Henry's avatar
Sylvain Henry committed
819 820 821
That is 'LitRubbish'.  Since we need a rubbish literal for
many boxed, unlifted types, we say that LitRubbish has type
  LitRubbish :: forall (a :: TYPE UnliftedRep). a
822 823

So we might see a w/w split like
Sylvain Henry's avatar
Sylvain Henry committed
824
  $wf x z = let y :: Array# Int = LitRubbish @(Array# Int)
825 826 827 828 829 830 831
            in e

Recall that (TYPE UnliftedRep) is the kind of boxed, unlifted
heap pointers.

Here are the moving parts:

Sylvain Henry's avatar
Sylvain Henry committed
832
* We define LitRubbish as a constructor in Literal.Literal
833 834 835

* It is given its polymoprhic type by Literal.literalType

Sylvain Henry's avatar
Sylvain Henry committed
836 837
* WwLib.mk_absent_let introduces a LitRubbish for absent
  arguments of boxed, unlifted type.
838 839 840 841 842 843

* In CoreToSTG we convert (RubishLit @t) to just ().  STG is
  untyped, so it doesn't matter that it points to a lifted
  value. The important thing is that it is a heap pointer,
  which the garbage collector can follow if it encounters it.

Sylvain Henry's avatar
Sylvain Henry committed
844
  We considered maintaining LitRubbish in STG, and lowering
845 846 847 848 849
  it in the code genreators, but it seems simpler to do it
  once and for all in CoreToSTG.

  In ByteCodeAsm we just lower it as a 0 literal, because
  it's all boxed and lifted to the host GC anyway.
850
-}