1{- 2(c) The University of Glasgow 2006 3(c) The GRASP/AQUA Project, Glasgow University, 1998 4 5-} 6 7{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-} 8{-# LANGUAGE TypeApplications #-} 9{-# LANGUAGE MagicHash #-} 10{-# LANGUAGE AllowAmbiguousTypes #-} 11 12{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 13 14-- | Core literals 15module GHC.Types.Literal 16 ( 17 -- * Main data type 18 Literal(..) -- Exported to ParseIface 19 , LitNumType(..) 20 21 -- ** Creating Literals 22 , mkLitInt, mkLitIntWrap, mkLitIntWrapC, mkLitIntUnchecked 23 , mkLitWord, mkLitWordWrap, mkLitWordWrapC 24 , mkLitInt8, mkLitInt8Wrap 25 , mkLitWord8, mkLitWord8Wrap 26 , mkLitInt16, mkLitInt16Wrap 27 , mkLitWord16, mkLitWord16Wrap 28 , mkLitInt32, mkLitInt32Wrap 29 , mkLitWord32, mkLitWord32Wrap 30 , mkLitInt64, mkLitInt64Wrap 31 , mkLitWord64, mkLitWord64Wrap 32 , mkLitFloat, mkLitDouble 33 , mkLitChar, mkLitString 34 , mkLitInteger, mkLitNatural 35 , mkLitNumber, mkLitNumberWrap 36 37 -- ** Operations on Literals 38 , literalType 39 , absentLiteralOf 40 , pprLiteral 41 , litNumIsSigned 42 , litNumCheckRange 43 , litNumWrap 44 , litNumCoerce 45 , litNumNarrow 46 , litNumBitSize 47 , isMinBound 48 , isMaxBound 49 50 -- ** Predicates on Literals and their contents 51 , litIsDupable, litIsTrivial, litIsLifted 52 , inCharRange 53 , isZeroLit, isOneLit 54 , litFitsInChar 55 , litValue, mapLitValue 56 , isLitValue_maybe 57 58 -- ** Coercions 59 , narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit 60 , narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit 61 , extendIntLit, extendWordLit 62 , charToIntLit, intToCharLit 63 , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit 64 , nullAddrLit, floatToDoubleLit, doubleToFloatLit 65 , rubbishLit, isRubbishLit 66 ) where 67 68#include "GhclibHsVersions.h" 69 70import GHC.Prelude 71 72import GHC.Builtin.Types.Prim 73import {-# SOURCE #-} GHC.Builtin.Types 74import GHC.Builtin.Names 75import GHC.Core.Type 76import GHC.Core.TyCon 77import GHC.Utils.Outputable 78import GHC.Data.FastString 79import GHC.Types.Basic 80import GHC.Utils.Binary 81import GHC.Settings.Constants 82import GHC.Platform 83import GHC.Types.Unique.FM 84import GHC.Utils.Misc 85import GHC.Utils.Panic 86 87import Data.ByteString (ByteString) 88import Data.Int 89import Data.Word 90import Data.Char 91import Data.Data ( Data ) 92import GHC.Exts 93import Numeric ( fromRat ) 94 95{- 96************************************************************************ 97* * 98\subsection{Literals} 99* * 100************************************************************************ 101-} 102 103-- | So-called 'Literal's are one of: 104-- 105-- * An unboxed numeric literal or floating-point literal which is presumed 106-- to be surrounded by appropriate constructors (@Int#@, etc.), so that 107-- the overall thing makes sense. 108-- 109-- We maintain the invariant that the 'Integer' in the 'LitNumber' 110-- constructor is actually in the (possibly target-dependent) range. 111-- The mkLit{Int,Word}*Wrap smart constructors ensure this by applying 112-- the target machine's wrapping semantics. Use these in situations 113-- where you know the wrapping semantics are correct. 114-- 115-- * The literal derived from the label mentioned in a \"foreign label\" 116-- declaration ('LitLabel') 117-- 118-- * A 'LitRubbish' to be used in place of values of 'UnliftedRep' 119-- (i.e. 'MutVar#') when the value is never used. 120-- 121-- * A character 122-- * A string 123-- * The NULL pointer 124-- 125data Literal 126 = LitChar Char -- ^ @Char#@ - at least 31 bits. Create with 127 -- 'mkLitChar' 128 129 | LitNumber !LitNumType !Integer 130 -- ^ Any numeric literal that can be 131 -- internally represented with an Integer. 132 133 | LitString !ByteString -- ^ A string-literal: stored and emitted 134 -- UTF-8 encoded, we'll arrange to decode it 135 -- at runtime. Also emitted with a @\'\\0\'@ 136 -- terminator. Create with 'mkLitString' 137 138 | LitNullAddr -- ^ The @NULL@ pointer, the only pointer value 139 -- that can be represented as a Literal. Create 140 -- with 'nullAddrLit' 141 142 | LitRubbish Bool -- ^ A nonsense value; always boxed, but 143 -- True <=> lifted, False <=> unlifted 144 -- Used when a binding is absent. 145 -- See Note [Rubbish literals] 146 147 | LitFloat Rational -- ^ @Float#@. Create with 'mkLitFloat' 148 | LitDouble Rational -- ^ @Double#@. Create with 'mkLitDouble' 149 150 | LitLabel FastString (Maybe Int) FunctionOrData 151 -- ^ A label literal. Parameters: 152 -- 153 -- 1) The name of the symbol mentioned in the 154 -- declaration 155 -- 156 -- 2) The size (in bytes) of the arguments 157 -- the label expects. Only applicable with 158 -- @stdcall@ labels. @Just x@ => @\<x\>@ will 159 -- be appended to label name when emitting 160 -- assembly. 161 -- 162 -- 3) Flag indicating whether the symbol 163 -- references a function or a data 164 deriving Data 165 166-- | Numeric literal type 167data LitNumType 168 = LitNumInteger -- ^ @Integer@ (see Note [BigNum literals]) 169 | LitNumNatural -- ^ @Natural@ (see Note [BigNum literals]) 170 | LitNumInt -- ^ @Int#@ - according to target machine 171 | LitNumInt8 -- ^ @Int8#@ - exactly 8 bits 172 | LitNumInt16 -- ^ @Int16#@ - exactly 16 bits 173 | LitNumInt32 -- ^ @Int32#@ - exactly 32 bits 174 | LitNumInt64 -- ^ @Int64#@ - exactly 64 bits 175 | LitNumWord -- ^ @Word#@ - according to target machine 176 | LitNumWord8 -- ^ @Word8#@ - exactly 8 bits 177 | LitNumWord16 -- ^ @Word16#@ - exactly 16 bits 178 | LitNumWord32 -- ^ @Word32#@ - exactly 32 bits 179 | LitNumWord64 -- ^ @Word64#@ - exactly 64 bits 180 deriving (Data,Enum,Eq,Ord) 181 182-- | Indicate if a numeric literal type supports negative numbers 183litNumIsSigned :: LitNumType -> Bool 184litNumIsSigned nt = case nt of 185 LitNumInteger -> True 186 LitNumNatural -> False 187 LitNumInt -> True 188 LitNumInt8 -> True 189 LitNumInt16 -> True 190 LitNumInt32 -> True 191 LitNumInt64 -> True 192 LitNumWord -> False 193 LitNumWord8 -> False 194 LitNumWord16 -> False 195 LitNumWord32 -> False 196 LitNumWord64 -> False 197 198-- | Number of bits 199litNumBitSize :: Platform -> LitNumType -> Maybe Word 200litNumBitSize platform nt = case nt of 201 LitNumInteger -> Nothing 202 LitNumNatural -> Nothing 203 LitNumInt -> Just (fromIntegral (platformWordSizeInBits platform)) 204 LitNumInt8 -> Just 8 205 LitNumInt16 -> Just 16 206 LitNumInt32 -> Just 32 207 LitNumInt64 -> Just 64 208 LitNumWord -> Just (fromIntegral (platformWordSizeInBits platform)) 209 LitNumWord8 -> Just 8 210 LitNumWord16 -> Just 16 211 LitNumWord32 -> Just 32 212 LitNumWord64 -> Just 64 213 214instance Binary LitNumType where 215 put_ bh numTyp = putByte bh (fromIntegral (fromEnum numTyp)) 216 get bh = do 217 h <- getByte bh 218 return (toEnum (fromIntegral h)) 219 220{- 221Note [BigNum literals] 222~~~~~~~~~~~~~~~~~~~~~~ 223 224GHC supports 2 kinds of arbitrary precision integers (a.k.a BigNum): 225 226 * Natural: natural represented as a Word# or as a BigNat 227 228 * Integer: integer represented a an Int# or as a BigNat (Integer's 229 constructors indicate the sign) 230 231BigNum literal instances are removed from Core during the CorePrep phase. They 232are replaced with expression to build them at runtime from machine literals 233(Word#, Int#, etc.) or from a list of Word#s. 234 235Note [String literals] 236~~~~~~~~~~~~~~~~~~~~~~ 237 238String literals are UTF-8 encoded and stored into ByteStrings in the following 239ASTs: Haskell, Core, Stg, Cmm. TH can also emit ByteString based string literals 240with the BytesPrimL constructor (see #14741). 241 242It wasn't true before as [Word8] was used in Cmm AST and in TH which was quite 243bad for performance with large strings (see #16198 and #14741). 244 245To include string literals into output objects, the assembler code generator has 246to embed the UTF-8 encoded binary blob. See Note [Embedding large binary blobs] 247for more details. 248 249-} 250 251instance Binary Literal where 252 put_ bh (LitChar aa) = do putByte bh 0; put_ bh aa 253 put_ bh (LitString ab) = do putByte bh 1; put_ bh ab 254 put_ bh (LitNullAddr) = putByte bh 2 255 put_ bh (LitFloat ah) = do putByte bh 3; put_ bh ah 256 put_ bh (LitDouble ai) = do putByte bh 4; put_ bh ai 257 put_ bh (LitLabel aj mb fod) 258 = do putByte bh 5 259 put_ bh aj 260 put_ bh mb 261 put_ bh fod 262 put_ bh (LitNumber nt i) 263 = do putByte bh 6 264 put_ bh nt 265 put_ bh i 266 put_ bh (LitRubbish b) = do putByte bh 7; put_ bh b 267 get bh = do 268 h <- getByte bh 269 case h of 270 0 -> do 271 aa <- get bh 272 return (LitChar aa) 273 1 -> do 274 ab <- get bh 275 return (LitString ab) 276 2 -> return (LitNullAddr) 277 3 -> do 278 ah <- get bh 279 return (LitFloat ah) 280 4 -> do 281 ai <- get bh 282 return (LitDouble ai) 283 5 -> do 284 aj <- get bh 285 mb <- get bh 286 fod <- get bh 287 return (LitLabel aj mb fod) 288 6 -> do 289 nt <- get bh 290 i <- get bh 291 return (LitNumber nt i) 292 _ -> do 293 b <- get bh 294 return (LitRubbish b) 295 296instance Outputable Literal where 297 ppr = pprLiteral id 298 299instance Eq Literal where 300 a == b = compare a b == EQ 301 302-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in 303-- 'GHC.Data.TrieMap.CoreMap'. 304instance Ord Literal where 305 compare = cmpLit 306 307{- 308 Construction 309 ~~~~~~~~~~~~ 310-} 311 312{- Note [Word/Int underflow/overflow] 313~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 314According to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and 315unsigned integral types): "All arithmetic is performed modulo 2^n, where n is 316the number of bits in the type." 317 318GHC stores Word# and Int# constant values as Integer. Core optimizations such 319as constant folding must ensure that the Integer value remains in the valid 320target Word/Int range (see #13172). The following functions are used to 321ensure this. 322 323Note that we *don't* warn the user about overflow. It's not done at runtime 324either, and compilation of completely harmless things like 325 ((124076834 :: Word32) + (2147483647 :: Word32)) 326doesn't yield a warning. Instead we simply squash the value into the *target* 327Int/Word range. 328-} 329 330-- | Make a literal number using wrapping semantics if the value is out of 331-- bound. 332mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Literal 333mkLitNumberWrap platform nt i = case nt of 334 LitNumInt -> case platformWordSize platform of 335 PW4 -> wrap @Int32 336 PW8 -> wrap @Int64 337 LitNumWord -> case platformWordSize platform of 338 PW4 -> wrap @Word32 339 PW8 -> wrap @Word64 340 LitNumInt8 -> wrap @Int8 341 LitNumInt16 -> wrap @Int16 342 LitNumInt32 -> wrap @Int32 343 LitNumInt64 -> wrap @Int64 344 LitNumWord8 -> wrap @Word8 345 LitNumWord16 -> wrap @Word16 346 LitNumWord32 -> wrap @Word32 347 LitNumWord64 -> wrap @Word64 348 LitNumInteger -> LitNumber nt i 349 LitNumNatural 350 | i < 0 -> panic "mkLitNumberWrap: trying to create a negative Natural" 351 | otherwise -> LitNumber nt i 352 where 353 wrap :: forall a. (Integral a, Num a) => Literal 354 wrap = LitNumber nt (toInteger (fromIntegral i :: a)) 355 356-- | Wrap a literal number according to its type using wrapping semantics. 357litNumWrap :: Platform -> Literal -> Literal 358litNumWrap platform (LitNumber nt i) = mkLitNumberWrap platform nt i 359litNumWrap _ l = pprPanic "litNumWrap" (ppr l) 360 361-- | Coerce a literal number into another using wrapping semantics. 362litNumCoerce :: LitNumType -> Platform -> Literal -> Literal 363litNumCoerce pt platform (LitNumber _nt i) = mkLitNumberWrap platform pt i 364litNumCoerce _ _ l = pprPanic "litNumWrapCoerce: not a number" (ppr l) 365 366-- | Narrow a literal number by converting it into another number type and then 367-- converting it back to its original type. 368litNumNarrow :: LitNumType -> Platform -> Literal -> Literal 369litNumNarrow pt platform (LitNumber nt i) 370 = case mkLitNumberWrap platform pt i of 371 LitNumber _ j -> mkLitNumberWrap platform nt j 372 l -> pprPanic "litNumNarrow: got invalid literal" (ppr l) 373litNumNarrow _ _ l = pprPanic "litNumNarrow: invalid literal" (ppr l) 374 375 376-- | Check that a given number is in the range of a numeric literal 377litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool 378litNumCheckRange platform nt i = case nt of 379 LitNumInt -> platformInIntRange platform i 380 LitNumWord -> platformInWordRange platform i 381 LitNumInt8 -> inBoundedRange @Int8 i 382 LitNumInt16 -> inBoundedRange @Int16 i 383 LitNumInt32 -> inBoundedRange @Int32 i 384 LitNumInt64 -> inBoundedRange @Int64 i 385 LitNumWord8 -> inBoundedRange @Word8 i 386 LitNumWord16 -> inBoundedRange @Word16 i 387 LitNumWord32 -> inBoundedRange @Word32 i 388 LitNumWord64 -> inBoundedRange @Word64 i 389 LitNumNatural -> i >= 0 390 LitNumInteger -> True 391 392-- | Create a numeric 'Literal' of the given type 393mkLitNumber :: Platform -> LitNumType -> Integer -> Literal 394mkLitNumber platform nt i = 395 ASSERT2(litNumCheckRange platform nt i, integer i) 396 (LitNumber nt i) 397 398-- | Creates a 'Literal' of type @Int#@ 399mkLitInt :: Platform -> Integer -> Literal 400mkLitInt platform x = ASSERT2( platformInIntRange platform x, integer x ) 401 (mkLitIntUnchecked x) 402 403-- | Creates a 'Literal' of type @Int#@. 404-- If the argument is out of the (target-dependent) range, it is wrapped. 405-- See Note [Word/Int underflow/overflow] 406mkLitIntWrap :: Platform -> Integer -> Literal 407mkLitIntWrap platform i = mkLitNumberWrap platform LitNumInt i 408 409-- | Creates a 'Literal' of type @Int#@ without checking its range. 410mkLitIntUnchecked :: Integer -> Literal 411mkLitIntUnchecked i = LitNumber LitNumInt i 412 413-- | Creates a 'Literal' of type @Int#@, as well as a 'Bool'ean flag indicating 414-- overflow. That is, if the argument is out of the (target-dependent) range 415-- the argument is wrapped and the overflow flag will be set. 416-- See Note [Word/Int underflow/overflow] 417mkLitIntWrapC :: Platform -> Integer -> (Literal, Bool) 418mkLitIntWrapC platform i = (n, i /= i') 419 where 420 n@(LitNumber _ i') = mkLitIntWrap platform i 421 422-- | Creates a 'Literal' of type @Word#@ 423mkLitWord :: Platform -> Integer -> Literal 424mkLitWord platform x = ASSERT2( platformInWordRange platform x, integer x ) 425 (mkLitWordUnchecked x) 426 427-- | Creates a 'Literal' of type @Word#@. 428-- If the argument is out of the (target-dependent) range, it is wrapped. 429-- See Note [Word/Int underflow/overflow] 430mkLitWordWrap :: Platform -> Integer -> Literal 431mkLitWordWrap platform i = mkLitNumberWrap platform LitNumWord i 432 433-- | Creates a 'Literal' of type @Word#@ without checking its range. 434mkLitWordUnchecked :: Integer -> Literal 435mkLitWordUnchecked i = LitNumber LitNumWord i 436 437-- | Creates a 'Literal' of type @Word#@, as well as a 'Bool'ean flag indicating 438-- carry. That is, if the argument is out of the (target-dependent) range 439-- the argument is wrapped and the carry flag will be set. 440-- See Note [Word/Int underflow/overflow] 441mkLitWordWrapC :: Platform -> Integer -> (Literal, Bool) 442mkLitWordWrapC platform i = (n, i /= i') 443 where 444 n@(LitNumber _ i') = mkLitWordWrap platform i 445 446-- | Creates a 'Literal' of type @Int8#@ 447mkLitInt8 :: Integer -> Literal 448mkLitInt8 x = ASSERT2( inBoundedRange @Int8 x, integer x ) (mkLitInt8Unchecked x) 449 450-- | Creates a 'Literal' of type @Int8#@. 451-- If the argument is out of the range, it is wrapped. 452mkLitInt8Wrap :: Integer -> Literal 453mkLitInt8Wrap i = mkLitInt8Unchecked (toInteger (fromIntegral i :: Int8)) 454 455-- | Creates a 'Literal' of type @Int8#@ without checking its range. 456mkLitInt8Unchecked :: Integer -> Literal 457mkLitInt8Unchecked i = LitNumber LitNumInt8 i 458 459-- | Creates a 'Literal' of type @Word8#@ 460mkLitWord8 :: Integer -> Literal 461mkLitWord8 x = ASSERT2( inBoundedRange @Word8 x, integer x ) (mkLitWord8Unchecked x) 462 463-- | Creates a 'Literal' of type @Word8#@. 464-- If the argument is out of the range, it is wrapped. 465mkLitWord8Wrap :: Integer -> Literal 466mkLitWord8Wrap i = mkLitWord8Unchecked (toInteger (fromIntegral i :: Word8)) 467 468-- | Creates a 'Literal' of type @Word8#@ without checking its range. 469mkLitWord8Unchecked :: Integer -> Literal 470mkLitWord8Unchecked i = LitNumber LitNumWord8 i 471 472-- | Creates a 'Literal' of type @Int16#@ 473mkLitInt16 :: Integer -> Literal 474mkLitInt16 x = ASSERT2( inBoundedRange @Int16 x, integer x ) (mkLitInt16Unchecked x) 475 476-- | Creates a 'Literal' of type @Int16#@. 477-- If the argument is out of the range, it is wrapped. 478mkLitInt16Wrap :: Integer -> Literal 479mkLitInt16Wrap i = mkLitInt16Unchecked (toInteger (fromIntegral i :: Int16)) 480 481-- | Creates a 'Literal' of type @Int16#@ without checking its range. 482mkLitInt16Unchecked :: Integer -> Literal 483mkLitInt16Unchecked i = LitNumber LitNumInt16 i 484 485-- | Creates a 'Literal' of type @Word16#@ 486mkLitWord16 :: Integer -> Literal 487mkLitWord16 x = ASSERT2( inBoundedRange @Word16 x, integer x ) (mkLitWord16Unchecked x) 488 489-- | Creates a 'Literal' of type @Word16#@. 490-- If the argument is out of the range, it is wrapped. 491mkLitWord16Wrap :: Integer -> Literal 492mkLitWord16Wrap i = mkLitWord16Unchecked (toInteger (fromIntegral i :: Word16)) 493 494-- | Creates a 'Literal' of type @Word16#@ without checking its range. 495mkLitWord16Unchecked :: Integer -> Literal 496mkLitWord16Unchecked i = LitNumber LitNumWord16 i 497 498-- | Creates a 'Literal' of type @Int32#@ 499mkLitInt32 :: Integer -> Literal 500mkLitInt32 x = ASSERT2( inBoundedRange @Int32 x, integer x ) (mkLitInt32Unchecked x) 501 502-- | Creates a 'Literal' of type @Int32#@. 503-- If the argument is out of the range, it is wrapped. 504mkLitInt32Wrap :: Integer -> Literal 505mkLitInt32Wrap i = mkLitInt32Unchecked (toInteger (fromIntegral i :: Int32)) 506 507-- | Creates a 'Literal' of type @Int32#@ without checking its range. 508mkLitInt32Unchecked :: Integer -> Literal 509mkLitInt32Unchecked i = LitNumber LitNumInt32 i 510 511-- | Creates a 'Literal' of type @Word32#@ 512mkLitWord32 :: Integer -> Literal 513mkLitWord32 x = ASSERT2( inBoundedRange @Word32 x, integer x ) (mkLitWord32Unchecked x) 514 515-- | Creates a 'Literal' of type @Word32#@. 516-- If the argument is out of the range, it is wrapped. 517mkLitWord32Wrap :: Integer -> Literal 518mkLitWord32Wrap i = mkLitWord32Unchecked (toInteger (fromIntegral i :: Word32)) 519 520-- | Creates a 'Literal' of type @Word32#@ without checking its range. 521mkLitWord32Unchecked :: Integer -> Literal 522mkLitWord32Unchecked i = LitNumber LitNumWord32 i 523 524-- | Creates a 'Literal' of type @Int64#@ 525mkLitInt64 :: Integer -> Literal 526mkLitInt64 x = ASSERT2( inBoundedRange @Int64 x, integer x ) (mkLitInt64Unchecked x) 527 528-- | Creates a 'Literal' of type @Int64#@. 529-- If the argument is out of the range, it is wrapped. 530mkLitInt64Wrap :: Integer -> Literal 531mkLitInt64Wrap i = mkLitInt64Unchecked (toInteger (fromIntegral i :: Int64)) 532 533-- | Creates a 'Literal' of type @Int64#@ without checking its range. 534mkLitInt64Unchecked :: Integer -> Literal 535mkLitInt64Unchecked i = LitNumber LitNumInt64 i 536 537-- | Creates a 'Literal' of type @Word64#@ 538mkLitWord64 :: Integer -> Literal 539mkLitWord64 x = ASSERT2( inBoundedRange @Word64 x, integer x ) (mkLitWord64Unchecked x) 540 541-- | Creates a 'Literal' of type @Word64#@. 542-- If the argument is out of the range, it is wrapped. 543mkLitWord64Wrap :: Integer -> Literal 544mkLitWord64Wrap i = mkLitWord64Unchecked (toInteger (fromIntegral i :: Word64)) 545 546-- | Creates a 'Literal' of type @Word64#@ without checking its range. 547mkLitWord64Unchecked :: Integer -> Literal 548mkLitWord64Unchecked i = LitNumber LitNumWord64 i 549 550-- | Creates a 'Literal' of type @Float#@ 551mkLitFloat :: Rational -> Literal 552mkLitFloat = LitFloat 553 554-- | Creates a 'Literal' of type @Double#@ 555mkLitDouble :: Rational -> Literal 556mkLitDouble = LitDouble 557 558-- | Creates a 'Literal' of type @Char#@ 559mkLitChar :: Char -> Literal 560mkLitChar = LitChar 561 562-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to 563-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@ 564mkLitString :: String -> Literal 565-- stored UTF-8 encoded 566mkLitString s = LitString (bytesFS $ mkFastString s) 567 568mkLitInteger :: Integer -> Literal 569mkLitInteger x = LitNumber LitNumInteger x 570 571mkLitNatural :: Integer -> Literal 572mkLitNatural x = ASSERT2( inNaturalRange x, integer x ) 573 (LitNumber LitNumNatural x) 574 575inNaturalRange :: Integer -> Bool 576inNaturalRange x = x >= 0 577 578inBoundedRange :: forall a. (Bounded a, Integral a) => Integer -> Bool 579inBoundedRange x = x >= toInteger (minBound :: a) && 580 x <= toInteger (maxBound :: a) 581 582isMinBound :: Platform -> Literal -> Bool 583isMinBound _ (LitChar c) = c == minBound 584isMinBound platform (LitNumber nt i) = case nt of 585 LitNumInt -> i == platformMinInt platform 586 LitNumInt8 -> i == toInteger (minBound :: Int8) 587 LitNumInt16 -> i == toInteger (minBound :: Int16) 588 LitNumInt32 -> i == toInteger (minBound :: Int32) 589 LitNumInt64 -> i == toInteger (minBound :: Int64) 590 LitNumWord -> i == 0 591 LitNumWord8 -> i == 0 592 LitNumWord16 -> i == 0 593 LitNumWord32 -> i == 0 594 LitNumWord64 -> i == 0 595 LitNumNatural -> i == 0 596 LitNumInteger -> False 597isMinBound _ _ = False 598 599isMaxBound :: Platform -> Literal -> Bool 600isMaxBound _ (LitChar c) = c == maxBound 601isMaxBound platform (LitNumber nt i) = case nt of 602 LitNumInt -> i == platformMaxInt platform 603 LitNumInt8 -> i == toInteger (maxBound :: Int8) 604 LitNumInt16 -> i == toInteger (maxBound :: Int16) 605 LitNumInt32 -> i == toInteger (maxBound :: Int32) 606 LitNumInt64 -> i == toInteger (maxBound :: Int64) 607 LitNumWord -> i == platformMaxWord platform 608 LitNumWord8 -> i == toInteger (maxBound :: Word8) 609 LitNumWord16 -> i == toInteger (maxBound :: Word16) 610 LitNumWord32 -> i == toInteger (maxBound :: Word32) 611 LitNumWord64 -> i == toInteger (maxBound :: Word64) 612 LitNumNatural -> False 613 LitNumInteger -> False 614isMaxBound _ _ = False 615 616inCharRange :: Char -> Bool 617inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR 618 619-- | Tests whether the literal represents a zero of whatever type it is 620isZeroLit :: Literal -> Bool 621isZeroLit (LitNumber _ 0) = True 622isZeroLit (LitFloat 0) = True 623isZeroLit (LitDouble 0) = True 624isZeroLit _ = False 625 626-- | Tests whether the literal represents a one of whatever type it is 627isOneLit :: Literal -> Bool 628isOneLit (LitNumber _ 1) = True 629isOneLit (LitFloat 1) = True 630isOneLit (LitDouble 1) = True 631isOneLit _ = False 632 633-- | Returns the 'Integer' contained in the 'Literal', for when that makes 634-- sense, i.e. for 'Char', 'Int', 'Word', 'LitInteger' and 'LitNatural'. 635litValue :: Literal -> Integer 636litValue l = case isLitValue_maybe l of 637 Just x -> x 638 Nothing -> pprPanic "litValue" (ppr l) 639 640-- | Returns the 'Integer' contained in the 'Literal', for when that makes 641-- sense, i.e. for 'Char' and numbers. 642isLitValue_maybe :: Literal -> Maybe Integer 643isLitValue_maybe (LitChar c) = Just $ toInteger $ ord c 644isLitValue_maybe (LitNumber _ i) = Just i 645isLitValue_maybe _ = Nothing 646 647-- | Apply a function to the 'Integer' contained in the 'Literal', for when that 648-- makes sense, e.g. for 'Char' and numbers. 649-- For fixed-size integral literals, the result will be wrapped in accordance 650-- with the semantics of the target type. 651-- See Note [Word/Int underflow/overflow] 652mapLitValue :: Platform -> (Integer -> Integer) -> Literal -> Literal 653mapLitValue _ f (LitChar c) = mkLitChar (fchar c) 654 where fchar = chr . fromInteger . f . toInteger . ord 655mapLitValue platform f (LitNumber nt i) = mkLitNumberWrap platform nt (f i) 656mapLitValue _ _ l = pprPanic "mapLitValue" (ppr l) 657 658{- 659 Coercions 660 ~~~~~~~~~ 661-} 662 663charToIntLit, intToCharLit, 664 floatToIntLit, intToFloatLit, 665 doubleToIntLit, intToDoubleLit, 666 floatToDoubleLit, doubleToFloatLit 667 :: Literal -> Literal 668 669-- | Narrow a literal number (unchecked result range) 670narrowLit' :: forall a. Integral a => LitNumType -> Literal -> Literal 671narrowLit' nt' (LitNumber _ i) = LitNumber nt' (toInteger (fromInteger i :: a)) 672narrowLit' _ l = pprPanic "narrowLit" (ppr l) 673 674narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit, 675 narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit :: Literal -> Literal 676narrowInt8Lit = narrowLit' @Int8 LitNumInt8 677narrowInt16Lit = narrowLit' @Int16 LitNumInt16 678narrowInt32Lit = narrowLit' @Int32 LitNumInt32 679narrowInt64Lit = narrowLit' @Int64 LitNumInt64 680narrowWord8Lit = narrowLit' @Word8 LitNumWord8 681narrowWord16Lit = narrowLit' @Word16 LitNumWord16 682narrowWord32Lit = narrowLit' @Word32 LitNumWord32 683narrowWord64Lit = narrowLit' @Word64 LitNumWord64 684 685-- | Extend a fixed-width literal (e.g. 'Int16#') to a word-sized literal (e.g. 686-- 'Int#'). 687extendWordLit, extendIntLit :: Platform -> Literal -> Literal 688extendWordLit platform (LitNumber _nt i) = mkLitWord platform i 689extendWordLit _platform l = pprPanic "extendWordLit" (ppr l) 690extendIntLit platform (LitNumber _nt i) = mkLitInt platform i 691extendIntLit _platform l = pprPanic "extendIntLit" (ppr l) 692 693charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) 694charToIntLit l = pprPanic "charToIntLit" (ppr l) 695intToCharLit (LitNumber _ i) = LitChar (chr (fromInteger i)) 696intToCharLit l = pprPanic "intToCharLit" (ppr l) 697 698floatToIntLit (LitFloat f) = mkLitIntUnchecked (truncate f) 699floatToIntLit l = pprPanic "floatToIntLit" (ppr l) 700intToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) 701intToFloatLit l = pprPanic "intToFloatLit" (ppr l) 702 703doubleToIntLit (LitDouble f) = mkLitIntUnchecked (truncate f) 704doubleToIntLit l = pprPanic "doubleToIntLit" (ppr l) 705intToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) 706intToDoubleLit l = pprPanic "intToDoubleLit" (ppr l) 707 708floatToDoubleLit (LitFloat f) = LitDouble f 709floatToDoubleLit l = pprPanic "floatToDoubleLit" (ppr l) 710doubleToFloatLit (LitDouble d) = LitFloat d 711doubleToFloatLit l = pprPanic "doubleToFloatLit" (ppr l) 712 713nullAddrLit :: Literal 714nullAddrLit = LitNullAddr 715 716-- | A rubbish literal; see Note [Rubbish literals] 717rubbishLit :: Bool -> Literal 718rubbishLit is_lifted = LitRubbish is_lifted 719 720isRubbishLit :: Literal -> Bool 721isRubbishLit (LitRubbish {}) = True 722isRubbishLit _ = False 723 724{- 725 Predicates 726 ~~~~~~~~~~ 727-} 728 729-- | True if there is absolutely no penalty to duplicating the literal. 730-- False principally of strings. 731-- 732-- "Why?", you say? I'm glad you asked. Well, for one duplicating strings would 733-- blow up code sizes. Not only this, it's also unsafe. 734-- 735-- Consider a program that wants to traverse a string. One way it might do this 736-- is to first compute the Addr# pointing to the end of the string, and then, 737-- starting from the beginning, bump a pointer using eqAddr# to determine the 738-- end. For instance, 739-- 740-- @ 741-- -- Given pointers to the start and end of a string, count how many zeros 742-- -- the string contains. 743-- countZeros :: Addr# -> Addr# -> -> Int 744-- countZeros start end = go start 0 745-- where 746-- go off n 747-- | off `addrEq#` end = n 748-- | otherwise = go (off `plusAddr#` 1) n' 749-- where n' | isTrue# (indexInt8OffAddr# off 0# ==# 0#) = n + 1 750-- | otherwise = n 751-- @ 752-- 753-- Consider what happens if we considered strings to be trivial (and therefore 754-- duplicable) and emitted a call like @countZeros "hello"# ("hello"# 755-- `plusAddr`# 5)@. The beginning and end pointers do not belong to the same 756-- string, meaning that an iteration like the above would blow up terribly. 757-- This is what happened in #12757. 758-- 759-- Ultimately the solution here is to make primitive strings a bit more 760-- structured, ensuring that the compiler can't inline in ways that will break 761-- user code. One approach to this is described in #8472. 762litIsTrivial :: Literal -> Bool 763-- c.f. GHC.Core.Utils.exprIsTrivial 764litIsTrivial (LitString _) = False 765litIsTrivial (LitNumber nt _) = case nt of 766 LitNumInteger -> False 767 LitNumNatural -> False 768 LitNumInt -> True 769 LitNumInt8 -> True 770 LitNumInt16 -> True 771 LitNumInt32 -> True 772 LitNumInt64 -> True 773 LitNumWord -> True 774 LitNumWord8 -> True 775 LitNumWord16 -> True 776 LitNumWord32 -> True 777 LitNumWord64 -> True 778litIsTrivial _ = True 779 780-- | True if code space does not go bad if we duplicate this literal 781litIsDupable :: Platform -> Literal -> Bool 782-- c.f. GHC.Core.Utils.exprIsDupable 783litIsDupable platform x = case x of 784 (LitNumber nt i) -> case nt of 785 LitNumInteger -> platformInIntRange platform i 786 LitNumNatural -> platformInWordRange platform i 787 LitNumInt -> True 788 LitNumInt8 -> True 789 LitNumInt16 -> True 790 LitNumInt32 -> True 791 LitNumInt64 -> True 792 LitNumWord -> True 793 LitNumWord8 -> True 794 LitNumWord16 -> True 795 LitNumWord32 -> True 796 LitNumWord64 -> True 797 (LitString _) -> False 798 _ -> True 799 800litFitsInChar :: Literal -> Bool 801litFitsInChar (LitNumber _ i) = i >= toInteger (ord minBound) 802 && i <= toInteger (ord maxBound) 803litFitsInChar _ = False 804 805litIsLifted :: Literal -> Bool 806litIsLifted (LitNumber nt _) = case nt of 807 LitNumInteger -> True 808 LitNumNatural -> True 809 LitNumInt -> False 810 LitNumInt8 -> False 811 LitNumInt16 -> False 812 LitNumInt32 -> False 813 LitNumInt64 -> False 814 LitNumWord -> False 815 LitNumWord8 -> False 816 LitNumWord16 -> False 817 LitNumWord32 -> False 818 LitNumWord64 -> False 819litIsLifted _ = False 820 821{- 822 Types 823 ~~~~~ 824-} 825 826-- | Find the Haskell 'Type' the literal occupies 827literalType :: Literal -> Type 828literalType LitNullAddr = addrPrimTy 829literalType (LitChar _) = charPrimTy 830literalType (LitString _) = addrPrimTy 831literalType (LitFloat _) = floatPrimTy 832literalType (LitDouble _) = doublePrimTy 833literalType (LitLabel _ _ _) = addrPrimTy 834literalType (LitNumber lt _) = case lt of 835 LitNumInteger -> integerTy 836 LitNumNatural -> naturalTy 837 LitNumInt -> intPrimTy 838 LitNumInt8 -> int8PrimTy 839 LitNumInt16 -> int16PrimTy 840 LitNumInt32 -> int32PrimTy 841 LitNumInt64 -> int64PrimTy 842 LitNumWord -> wordPrimTy 843 LitNumWord8 -> word8PrimTy 844 LitNumWord16 -> word16PrimTy 845 LitNumWord32 -> word32PrimTy 846 LitNumWord64 -> word64PrimTy 847literalType (LitRubbish is_lifted) = mkForAllTy a Inferred (mkTyVarTy a) 848 where 849 -- See Note [Rubbish literals] 850 a | is_lifted = alphaTyVar 851 | otherwise = alphaTyVarUnliftedRep 852 853absentLiteralOf :: TyCon -> Maybe Literal 854-- Return a literal of the appropriate primitive 855-- TyCon, to use as a placeholder when it doesn't matter 856-- Rubbish literals are handled in GHC.Core.Opt.WorkWrap.Utils, because 857-- 1. Looking at the TyCon is not enough, we need the actual type 858-- 2. This would need to return a type application to a literal 859absentLiteralOf tc = lookupUFM absent_lits tc 860 861-- We do not use TyConEnv here to avoid import cycles. 862absent_lits :: UniqFM TyCon Literal 863absent_lits = listToUFM_Directly 864 -- Explicitly construct the mape from the known 865 -- keys of these tyCons. 866 [ (addrPrimTyConKey, LitNullAddr) 867 , (charPrimTyConKey, LitChar 'x') 868 , (intPrimTyConKey, mkLitIntUnchecked 0) 869 , (int8PrimTyConKey, mkLitInt8Unchecked 0) 870 , (int16PrimTyConKey, mkLitInt16Unchecked 0) 871 , (int32PrimTyConKey, mkLitInt32Unchecked 0) 872 , (int64PrimTyConKey, mkLitInt64Unchecked 0) 873 , (wordPrimTyConKey, mkLitWordUnchecked 0) 874 , (word8PrimTyConKey, mkLitWord8Unchecked 0) 875 , (word16PrimTyConKey, mkLitWord16Unchecked 0) 876 , (word32PrimTyConKey, mkLitWord32Unchecked 0) 877 , (word64PrimTyConKey, mkLitWord64Unchecked 0) 878 , (floatPrimTyConKey, LitFloat 0) 879 , (doublePrimTyConKey, LitDouble 0) 880 ] 881 882{- 883 Comparison 884 ~~~~~~~~~~ 885-} 886 887cmpLit :: Literal -> Literal -> Ordering 888cmpLit (LitChar a) (LitChar b) = a `compare` b 889cmpLit (LitString a) (LitString b) = a `compare` b 890cmpLit (LitNullAddr) (LitNullAddr) = EQ 891cmpLit (LitFloat a) (LitFloat b) = a `compare` b 892cmpLit (LitDouble a) (LitDouble b) = a `compare` b 893cmpLit (LitLabel a _ _) (LitLabel b _ _) = a `lexicalCompareFS` b 894cmpLit (LitNumber nt1 a) (LitNumber nt2 b) 895 = (nt1 `compare` nt2) `mappend` (a `compare` b) 896cmpLit (LitRubbish b1) (LitRubbish b2) = b1 `compare` b2 897cmpLit lit1 lit2 898 | isTrue# (dataToTag# lit1 <# dataToTag# lit2) = LT 899 | otherwise = GT 900 901{- 902 Printing 903 ~~~~~~~~ 904* See Note [Printing of literals in Core] 905-} 906 907pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc 908pprLiteral _ (LitChar c) = pprPrimChar c 909pprLiteral _ (LitString s) = pprHsBytes s 910pprLiteral _ (LitNullAddr) = text "__NULL" 911pprLiteral _ (LitFloat f) = float (fromRat f) <> primFloatSuffix 912pprLiteral _ (LitDouble d) = double (fromRat d) <> primDoubleSuffix 913pprLiteral add_par (LitNumber nt i) 914 = case nt of 915 LitNumInteger -> pprIntegerVal add_par i 916 LitNumNatural -> pprIntegerVal add_par i 917 LitNumInt -> pprPrimInt i 918 LitNumInt8 -> pprPrimInt8 i 919 LitNumInt16 -> pprPrimInt16 i 920 LitNumInt32 -> pprPrimInt32 i 921 LitNumInt64 -> pprPrimInt64 i 922 LitNumWord -> pprPrimWord i 923 LitNumWord8 -> pprPrimWord8 i 924 LitNumWord16 -> pprPrimWord16 i 925 LitNumWord32 -> pprPrimWord32 i 926 LitNumWord64 -> pprPrimWord64 i 927pprLiteral add_par (LitLabel l mb fod) = 928 add_par (text "__label" <+> b <+> ppr fod) 929 where b = case mb of 930 Nothing -> pprHsString l 931 Just x -> doubleQuotes (text (unpackFS l ++ '@':show x)) 932pprLiteral _ (LitRubbish is_lifted) 933 = text "__RUBBISH" 934 <> parens (if is_lifted then text "lifted" else text "unlifted") 935 936pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc 937-- See Note [Printing of literals in Core]. 938pprIntegerVal add_par i | i < 0 = add_par (integer i) 939 | otherwise = integer i 940 941{- 942Note [Printing of literals in Core] 943~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 944The function `add_par` is used to wrap parenthesis around negative integers 945(`LitInteger`) and labels (`LitLabel`), if they occur in a context requiring 946an atomic thing (for example function application). 947 948Although not all Core literals would be valid Haskell, we are trying to stay 949as close as possible to Haskell syntax in the printing of Core, to make it 950easier for a Haskell user to read Core. 951 952To that end: 953 * We do print parenthesis around negative `LitInteger`, because we print 954 `LitInteger` using plain number literals (no prefix or suffix), and plain 955 number literals in Haskell require parenthesis in contexts like function 956 application (i.e. `1 - -1` is not valid Haskell). 957 958 * We don't print parenthesis around other (negative) literals, because they 959 aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's 960 parser). 961 962Literal Output Output if context requires 963 an atom (if different) 964------- ------- ---------------------- 965LitChar 'a'# 966LitString "aaa"# 967LitNullAddr "__NULL" 968LitInt -1# 969LitIntN -1#N 970LitWord 1## 971LitWordN 1##N 972LitFloat -1.0# 973LitDouble -1.0## 974LitInteger -1 (-1) 975LitLabel "__label" ... ("__label" ...) 976LitRubbish "__RUBBISH" 977 978Note [Rubbish literals] 979~~~~~~~~~~~~~~~~~~~~~~~ 980During worker/wrapper after demand analysis, where an argument 981is unused (absent) we do the following w/w split (supposing that 982y is absent): 983 984 f x y z = e 985===> 986 f x y z = $wf x z 987 $wf x z = let y = <absent value> 988 in e 989 990Usually the binding for y is ultimately optimised away, and 991even if not it should never be evaluated -- but that's the 992way the w/w split starts off. 993 994What is <absent value>? 995* For lifted values <absent value> can be a call to 'error'. 996* For primitive types like Int# or Word# we can use any random 997 value of that type. 998* But what about /unlifted/ but /boxed/ types like MutVar# or 999 Array#? Or /lifted/ but /strict/ values, such as a field of 1000 a strict data constructor. For these we use LitRubbish. 1001 See Note [Absent errors] in GHC.Core.Opt.WorkWrap.Utils.hs 1002 1003The literal (LitRubbish is_lifted) 1004has type 1005 LitRubbish :: forall (a :: TYPE LiftedRep). a if is_lifted 1006 LitRubbish :: forall (a :: TYPE UnliftedRep). a otherwise 1007 1008So we might see a w/w split like 1009 $wf x z = let y :: Array# Int = (LitRubbish False) @(Array# Int) 1010 in e 1011 1012Here are the moving parts, but see also Note [Absent errors] in 1013GHC.Core.Opt.WorkWrap.Utils 1014 1015* We define LitRubbish as a constructor in GHC.Types.Literal.Literal 1016 1017* It is given its polymorphic type by Literal.literalType 1018 1019* GHC.Core.Opt.WorkWrap.Utils.mk_absent_let introduces a LitRubbish for absent 1020 arguments of boxed, unlifted type; or boxed, lifted arguments of strict data 1021 constructors. 1022 1023* In CoreToSTG we convert (RubishLit @t) to just (). STG is untyped, so this 1024 will work OK for both lifted and unlifted (but boxed) values. The important 1025 thing is that it is a heap pointer, which the garbage collector can follow if 1026 it encounters it. 1027 1028 We considered maintaining LitRubbish in STG, and lowering it in the code 1029 generators, but it seems simpler to do it once and for all in CoreToSTG. 1030 1031 In GHC.ByteCode.Asm we just lower it as a 0 literal, because it's all boxed to 1032 the host GC anyway. 1033-} 1034