PageRenderTime 43ms CodeModel.GetById 36ms app.highlight 2ms RepoModel.GetById 1ms app.codeStats 0ms

/compiler/basicTypes/Literal.lhs

https://bitbucket.org/carter/ghc
Haskell | 494 lines | 369 code | 69 blank | 56 comment | 9 complexity | 7cf3d788935414bf8f98946fc8b11ae7 MD5 | raw file
  1%
  2% (c) The University of Glasgow 2006
  3% (c) The GRASP/AQUA Project, Glasgow University, 1998
  4%
  5\section[Literal]{@Literal@: Machine literals (unboxed, of course)}
  6
  7\begin{code}
  8{-# LANGUAGE DeriveDataTypeable #-}
  9
 10module Literal
 11        (
 12        -- * Main data type
 13          Literal(..)           -- Exported to ParseIface
 14
 15        -- ** Creating Literals
 16        , mkMachInt, mkMachWord
 17        , mkMachInt64, mkMachWord64
 18        , mkMachFloat, mkMachDouble
 19        , mkMachChar, mkMachString
 20        , mkLitInteger
 21
 22        -- ** Operations on Literals
 23        , literalType
 24        , hashLiteral
 25        , absentLiteralOf
 26        , pprLiteral
 27
 28        -- ** Predicates on Literals and their contents
 29        , litIsDupable, litIsTrivial, litIsLifted
 30        , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
 31        , isZeroLit
 32        , litFitsInChar
 33
 34        -- ** Coercions
 35        , word2IntLit, int2WordLit
 36        , narrow8IntLit, narrow16IntLit, narrow32IntLit
 37        , narrow8WordLit, narrow16WordLit, narrow32WordLit
 38        , char2IntLit, int2CharLit
 39        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
 40        , nullAddrLit, float2DoubleLit, double2FloatLit
 41        ) where
 42
 43#include "HsVersions.h"
 44
 45import TysPrim
 46import PrelNames
 47import Type
 48import TyCon
 49import Outputable
 50import FastTypes
 51import FastString
 52import BasicTypes
 53import Binary
 54import Constants
 55import DynFlags
 56import UniqFM
 57import Util
 58
 59import Data.Int
 60import Data.Ratio
 61import Data.Word
 62import Data.Char
 63import Data.Data ( Data, Typeable )
 64import Numeric ( fromRat )
 65\end{code}
 66
 67
 68%************************************************************************
 69%*                                                                      *
 70\subsection{Literals}
 71%*                                                                      *
 72%************************************************************************
 73
 74\begin{code}
 75-- | So-called 'Literal's are one of:
 76--
 77-- * An unboxed (/machine/) literal ('MachInt', 'MachFloat', etc.),
 78--   which is presumed to be surrounded by appropriate constructors
 79--   (@Int#@, etc.), so that the overall thing makes sense.
 80--
 81-- * The literal derived from the label mentioned in a \"foreign label\"
 82--   declaration ('MachLabel')
 83data Literal
 84  =     ------------------
 85        -- First the primitive guys
 86    MachChar    Char            -- ^ @Char#@ - at least 31 bits. Create with 'mkMachChar'
 87
 88  | MachStr     FastBytes       -- ^ A string-literal: stored and emitted
 89                                -- UTF-8 encoded, we'll arrange to decode it
 90                                -- at runtime.  Also emitted with a @'\0'@
 91                                -- terminator. Create with 'mkMachString'
 92
 93  | MachNullAddr                -- ^ The @NULL@ pointer, the only pointer value
 94                                -- that can be represented as a Literal. Create
 95                                -- with 'nullAddrLit'
 96
 97  | MachInt     Integer         -- ^ @Int#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachInt'
 98  | MachInt64   Integer         -- ^ @Int64#@ - at least 64 bits. Create with 'mkMachInt64'
 99  | MachWord    Integer         -- ^ @Word#@ - at least @WORD_SIZE_IN_BITS@ bits. Create with 'mkMachWord'
100  | MachWord64  Integer         -- ^ @Word64#@ - at least 64 bits. Create with 'mkMachWord64'
101
102  | MachFloat   Rational        -- ^ @Float#@. Create with 'mkMachFloat'
103  | MachDouble  Rational        -- ^ @Double#@. Create with 'mkMachDouble'
104
105  | MachLabel   FastString
106                (Maybe Int)
107        FunctionOrData
108                -- ^ A label literal. Parameters:
109                        --
110                        -- 1) The name of the symbol mentioned in the declaration
111                        --
112                        -- 2) The size (in bytes) of the arguments
113                                --    the label expects. Only applicable with
114                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
115                                --    be appended to label name when emitting assembly.
116
117  | LitInteger Integer Type --  ^ Integer literals
118                            -- See Note [Integer literals]
119  deriving (Data, Typeable)
120\end{code}
121
122Note [Integer literals]
123~~~~~~~~~~~~~~~~~~~~~~~
124An Integer literal is represented using, well, an Integer, to make it
125easier to write RULEs for them. They also contain the Integer type, so
126that e.g. literalType can return the right Type for them.
127
128They only get converted into real Core,
129    mkInteger [c1, c2, .., cn]
130during the CorePrep phase, although TidyPgm looks ahead at what the
131core will be, so that it can see whether it involves CAFs.
132
133When we initally build an Integer literal, notably when
134deserialising it from an interface file (see the Binary instance
135below), we don't have convenient access to the mkInteger Id.  So we
136just use an error thunk, and fill in the real Id when we do tcIfaceLit
137in TcIface.
138
139
140Binary instance
141
142\begin{code}
143instance Binary Literal where
144    put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
145    put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
146    put_ bh (MachNullAddr)    = do putByte bh 2
147    put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
148    put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
149    put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
150    put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
151    put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
152    put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
153    put_ bh (MachLabel aj mb fod)
154        = do putByte bh 9
155             put_ bh aj
156             put_ bh mb
157             put_ bh fod
158    put_ bh (LitInteger i _) = do putByte bh 10; put_ bh i
159    get bh = do
160            h <- getByte bh
161            case h of
162              0 -> do
163                    aa <- get bh
164                    return (MachChar aa)
165              1 -> do
166                    ab <- get bh
167                    return (MachStr ab)
168              2 -> do
169                    return (MachNullAddr)
170              3 -> do
171                    ad <- get bh
172                    return (MachInt ad)
173              4 -> do
174                    ae <- get bh
175                    return (MachInt64 ae)
176              5 -> do
177                    af <- get bh
178                    return (MachWord af)
179              6 -> do
180                    ag <- get bh
181                    return (MachWord64 ag)
182              7 -> do
183                    ah <- get bh
184                    return (MachFloat ah)
185              8 -> do
186                    ai <- get bh
187                    return (MachDouble ai)
188              9 -> do
189                    aj <- get bh
190                    mb <- get bh
191                    fod <- get bh
192                    return (MachLabel aj mb fod)
193              _ -> do
194                    i <- get bh
195                    -- See Note [Integer literals]
196                    return $ mkLitInteger i (panic "Evaluated the place holder for mkInteger")
197\end{code}
198
199\begin{code}
200instance Outputable Literal where
201    ppr lit = pprLiteral (\d -> d) lit
202
203instance Eq Literal where
204    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
205    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
206
207instance Ord Literal where
208    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
209    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
210    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
211    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
212    compare a b = cmpLit a b
213\end{code}
214
215
216        Construction
217        ~~~~~~~~~~~~
218\begin{code}
219-- | Creates a 'Literal' of type @Int#@
220mkMachInt :: DynFlags -> Integer -> Literal
221mkMachInt dflags x   = ASSERT2( inIntRange dflags x,  integer x )
222                       MachInt x
223
224-- | Creates a 'Literal' of type @Word#@
225mkMachWord :: DynFlags -> Integer -> Literal
226mkMachWord dflags x   = ASSERT2( inWordRange dflags x, integer x )
227                        MachWord x
228
229-- | Creates a 'Literal' of type @Int64#@
230mkMachInt64 :: Integer -> Literal
231mkMachInt64  x = MachInt64 x
232
233-- | Creates a 'Literal' of type @Word64#@
234mkMachWord64 :: Integer -> Literal
235mkMachWord64 x = MachWord64 x
236
237-- | Creates a 'Literal' of type @Float#@
238mkMachFloat :: Rational -> Literal
239mkMachFloat = MachFloat
240
241-- | Creates a 'Literal' of type @Double#@
242mkMachDouble :: Rational -> Literal
243mkMachDouble = MachDouble
244
245-- | Creates a 'Literal' of type @Char#@
246mkMachChar :: Char -> Literal
247mkMachChar = MachChar
248
249-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
250-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
251mkMachString :: String -> Literal
252-- stored UTF-8 encoded
253mkMachString s = MachStr (fastStringToFastBytes $ mkFastString s)
254
255mkLitInteger :: Integer -> Type -> Literal
256mkLitInteger = LitInteger
257
258inIntRange, inWordRange :: DynFlags -> Integer -> Bool
259inIntRange  dflags x = x >= tARGET_MIN_INT dflags && x <= tARGET_MAX_INT dflags
260inWordRange dflags x = x >= 0                     && x <= tARGET_MAX_WORD dflags
261
262inCharRange :: Char -> Bool
263inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
264
265-- | Tests whether the literal represents a zero of whatever type it is
266isZeroLit :: Literal -> Bool
267isZeroLit (MachInt    0) = True
268isZeroLit (MachInt64  0) = True
269isZeroLit (MachWord   0) = True
270isZeroLit (MachWord64 0) = True
271isZeroLit (MachFloat  0) = True
272isZeroLit (MachDouble 0) = True
273isZeroLit _              = False
274\end{code}
275
276        Coercions
277        ~~~~~~~~~
278\begin{code}
279narrow8IntLit, narrow16IntLit, narrow32IntLit,
280  narrow8WordLit, narrow16WordLit, narrow32WordLit,
281  char2IntLit, int2CharLit,
282  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
283  float2DoubleLit, double2FloatLit
284  :: Literal -> Literal
285
286word2IntLit, int2WordLit :: DynFlags -> Literal -> Literal
287word2IntLit dflags (MachWord w)
288  | w > tARGET_MAX_INT dflags = MachInt (w - tARGET_MAX_WORD dflags - 1)
289  | otherwise                 = MachInt w
290word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
291
292int2WordLit dflags (MachInt i)
293  | i < 0     = MachWord (1 + tARGET_MAX_WORD dflags + i)      -- (-1)  --->  tARGET_MAX_WORD
294  | otherwise = MachWord i
295int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
296
297narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
298narrow8IntLit    l            = pprPanic "narrow8IntLit" (ppr l)
299narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
300narrow16IntLit   l            = pprPanic "narrow16IntLit" (ppr l)
301narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
302narrow32IntLit   l            = pprPanic "narrow32IntLit" (ppr l)
303narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
304narrow8WordLit   l            = pprPanic "narrow8WordLit" (ppr l)
305narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
306narrow16WordLit  l            = pprPanic "narrow16WordLit" (ppr l)
307narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
308narrow32WordLit  l            = pprPanic "narrow32WordLit" (ppr l)
309
310char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
311char2IntLit l            = pprPanic "char2IntLit" (ppr l)
312int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
313int2CharLit l            = pprPanic "int2CharLit" (ppr l)
314
315float2IntLit (MachFloat f) = MachInt   (truncate    f)
316float2IntLit l             = pprPanic "float2IntLit" (ppr l)
317int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
318int2FloatLit l             = pprPanic "int2FloatLit" (ppr l)
319
320double2IntLit (MachDouble f) = MachInt    (truncate    f)
321double2IntLit l              = pprPanic "double2IntLit" (ppr l)
322int2DoubleLit (MachInt    i) = MachDouble (fromInteger i)
323int2DoubleLit l              = pprPanic "int2DoubleLit" (ppr l)
324
325float2DoubleLit (MachFloat  f) = MachDouble f
326float2DoubleLit l              = pprPanic "float2DoubleLit" (ppr l)
327double2FloatLit (MachDouble d) = MachFloat  d
328double2FloatLit l              = pprPanic "double2FloatLit" (ppr l)
329
330nullAddrLit :: Literal
331nullAddrLit = MachNullAddr
332\end{code}
333
334        Predicates
335        ~~~~~~~~~~
336\begin{code}
337-- | True if there is absolutely no penalty to duplicating the literal.
338-- False principally of strings
339litIsTrivial :: Literal -> Bool
340--      c.f. CoreUtils.exprIsTrivial
341litIsTrivial (MachStr _)      = False
342litIsTrivial (LitInteger {})  = False
343litIsTrivial _                = True
344
345-- | True if code space does not go bad if we duplicate this literal
346-- Currently we treat it just like 'litIsTrivial'
347litIsDupable :: DynFlags -> Literal -> Bool
348--      c.f. CoreUtils.exprIsDupable
349litIsDupable _      (MachStr _)      = False
350litIsDupable dflags (LitInteger i _) = inIntRange dflags i
351litIsDupable _      _                = True
352
353litFitsInChar :: Literal -> Bool
354litFitsInChar (MachInt i) = i >= toInteger (ord minBound)
355                         && i <= toInteger (ord maxBound)
356litFitsInChar _           = False
357
358litIsLifted :: Literal -> Bool
359litIsLifted (LitInteger {}) = True
360litIsLifted _               = False
361\end{code}
362
363        Types
364        ~~~~~
365\begin{code}
366-- | Find the Haskell 'Type' the literal occupies
367literalType :: Literal -> Type
368literalType MachNullAddr    = addrPrimTy
369literalType (MachChar _)    = charPrimTy
370literalType (MachStr  _)    = addrPrimTy
371literalType (MachInt  _)    = intPrimTy
372literalType (MachWord  _)   = wordPrimTy
373literalType (MachInt64  _)  = int64PrimTy
374literalType (MachWord64  _) = word64PrimTy
375literalType (MachFloat _)   = floatPrimTy
376literalType (MachDouble _)  = doublePrimTy
377literalType (MachLabel _ _ _) = addrPrimTy
378literalType (LitInteger _ t) = t
379
380absentLiteralOf :: TyCon -> Maybe Literal
381-- Return a literal of the appropriate primtive
382-- TyCon, to use as a placeholder when it doesn't matter
383absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
384
385absent_lits :: UniqFM Literal
386absent_lits = listToUFM [ (addrPrimTyConKey,    MachNullAddr)
387                        , (charPrimTyConKey,    MachChar 'x')
388                        , (intPrimTyConKey,     MachInt 0)
389                        , (int64PrimTyConKey,   MachInt64 0)
390                        , (floatPrimTyConKey,   MachFloat 0)
391                        , (doublePrimTyConKey,  MachDouble 0)
392                        , (wordPrimTyConKey,    MachWord 0)
393                        , (word64PrimTyConKey,  MachWord64 0) ]
394\end{code}
395
396
397        Comparison
398        ~~~~~~~~~~
399\begin{code}
400cmpLit :: Literal -> Literal -> Ordering
401cmpLit (MachChar      a)   (MachChar       b)   = a `compare` b
402cmpLit (MachStr       a)   (MachStr        b)   = a `compare` b
403cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
404cmpLit (MachInt       a)   (MachInt        b)   = a `compare` b
405cmpLit (MachWord      a)   (MachWord       b)   = a `compare` b
406cmpLit (MachInt64     a)   (MachInt64      b)   = a `compare` b
407cmpLit (MachWord64    a)   (MachWord64     b)   = a `compare` b
408cmpLit (MachFloat     a)   (MachFloat      b)   = a `compare` b
409cmpLit (MachDouble    a)   (MachDouble     b)   = a `compare` b
410cmpLit (MachLabel     a _ _) (MachLabel      b _ _) = a `compare` b
411cmpLit (LitInteger    a _) (LitInteger     b _) = a `compare` b
412cmpLit lit1                lit2                 | litTag lit1 <# litTag lit2 = LT
413                                                | otherwise                  = GT
414
415litTag :: Literal -> FastInt
416litTag (MachChar      _)   = _ILIT(1)
417litTag (MachStr       _)   = _ILIT(2)
418litTag (MachNullAddr)      = _ILIT(3)
419litTag (MachInt       _)   = _ILIT(4)
420litTag (MachWord      _)   = _ILIT(5)
421litTag (MachInt64     _)   = _ILIT(6)
422litTag (MachWord64    _)   = _ILIT(7)
423litTag (MachFloat     _)   = _ILIT(8)
424litTag (MachDouble    _)   = _ILIT(9)
425litTag (MachLabel _ _ _)   = _ILIT(10)
426litTag (LitInteger  {})    = _ILIT(11)
427\end{code}
428
429        Printing
430        ~~~~~~~~
431* MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
432  exceptions: MachFloat gets an initial keyword prefix.
433
434\begin{code}
435pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
436-- The function is used on non-atomic literals
437-- to wrap parens around literals that occur in
438-- a context requiring an atomic thing
439pprLiteral _       (MachChar ch)    = pprHsChar ch
440pprLiteral _       (MachStr s)      = pprHsBytes s
441pprLiteral _       (MachInt i)      = pprIntVal i
442pprLiteral _       (MachDouble d)   = double (fromRat d)
443pprLiteral _       (MachNullAddr)   = ptext (sLit "__NULL")
444pprLiteral add_par (LitInteger i _) = add_par (ptext (sLit "__integer") <+> integer i)
445pprLiteral add_par (MachInt64 i)    = add_par (ptext (sLit "__int64") <+> integer i)
446pprLiteral add_par (MachWord w)     = add_par (ptext (sLit "__word") <+> integer w)
447pprLiteral add_par (MachWord64 w)   = add_par (ptext (sLit "__word64") <+> integer w)
448pprLiteral add_par (MachFloat f)    = add_par (ptext (sLit "__float") <+> float (fromRat f))
449pprLiteral add_par (MachLabel l mb fod) = add_par (ptext (sLit "__label") <+> b <+> ppr fod)
450    where b = case mb of
451              Nothing -> pprHsString l
452              Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
453
454pprIntVal :: Integer -> SDoc
455-- ^ Print negative integers with parens to be sure it's unambiguous
456pprIntVal i | i < 0     = parens (integer i)
457            | otherwise = integer i
458\end{code}
459
460
461%************************************************************************
462%*                                                                      *
463\subsection{Hashing}
464%*                                                                      *
465%************************************************************************
466
467Hash values should be zero or a positive integer.  No negatives please.
468(They mess up the UniqFM for some reason.)
469
470\begin{code}
471hashLiteral :: Literal -> Int
472hashLiteral (MachChar c)        = ord c + 1000  -- Keep it out of range of common ints
473hashLiteral (MachStr s)         = hashFB s
474hashLiteral (MachNullAddr)      = 0
475hashLiteral (MachInt i)         = hashInteger i
476hashLiteral (MachInt64 i)       = hashInteger i
477hashLiteral (MachWord i)        = hashInteger i
478hashLiteral (MachWord64 i)      = hashInteger i
479hashLiteral (MachFloat r)       = hashRational r
480hashLiteral (MachDouble r)      = hashRational r
481hashLiteral (MachLabel s _ _)     = hashFS s
482hashLiteral (LitInteger i _)    = hashInteger i
483
484hashRational :: Rational -> Int
485hashRational r = hashInteger (numerator r)
486
487hashInteger :: Integer -> Int
488hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
489                -- The 1+ is to avoid zero, which is a Bad Number
490                -- since we use * to combine hash values
491
492hashFS :: FastString -> Int
493hashFS s = iBox (uniqueOfFS s)
494\end{code}