-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
+{-# LANGUAGE DeriveDataTypeable #-}
module Literal
(
, mkMachChar, mkMachString
-- ** Operations on Literals
- , litSize
, literalType
, hashLiteral
+ , absentLiteralOf
-- ** Predicates on Literals and their contents
, litIsDupable, litIsTrivial
) where
import TysPrim
+import PrelNames
import Type
+import TyCon
import Outputable
import FastTypes
import FastString
+import BasicTypes
import Binary
-import Ratio
-
+import Constants
+import UniqFM
import Data.Int
+import Data.Ratio
import Data.Word
import Data.Char
+import Data.Data( Data, Typeable )
\end{code}
%************************************************************************
%* *
-\subsection{Sizes}
-%* *
-%************************************************************************
-
-If we're compiling with GHC (and we're not cross-compiling), then we
-know that minBound and maxBound :: Int are the right values for the
-target architecture. Otherwise, we assume -2^31 and 2^31-1
-respectively (which will be wrong on a 64-bit machine).
-
-\begin{code}
-tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
-#ifdef __GLASGOW_HASKELL__
-tARGET_MIN_INT = toInteger (minBound :: Int)
-tARGET_MAX_INT = toInteger (maxBound :: Int)
-#else
-tARGET_MIN_INT = -2147483648
-tARGET_MAX_INT = 2147483647
-#endif
-tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
-
-tARGET_MAX_CHAR :: Int
-tARGET_MAX_CHAR = 0x10ffff
-\end{code}
-
-%************************************************************************
-%* *
\subsection{Literals}
%* *
%************************************************************************
| MachDouble Rational -- ^ @Double#@. Create with 'mkMachDouble'
| MachLabel FastString
- (Maybe Int) -- ^ A label literal. Parameters:
- --
- -- 1) The name of the symbol mentioned in the declaration
- --
- -- 2) The size (in bytes) of the arguments
+ (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.
+ deriving (Data, Typeable)
\end{code}
Binary instance
put_ bh (MachWord64 ag) = do putByte bh 6; put_ bh ag
put_ bh (MachFloat ah) = do putByte bh 7; put_ bh ah
put_ bh (MachDouble ai) = do putByte bh 8; put_ bh ai
- put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
+ put_ bh (MachLabel aj mb fod)
+ = do putByte bh 9
+ put_ bh aj
+ put_ bh mb
+ put_ bh fod
get bh = do
h <- getByte bh
case h of
9 -> do
aj <- get bh
mb <- get bh
- return (MachLabel aj mb)
+ fod <- get bh
+ return (MachLabel aj mb fod)
\end{code}
\begin{code}
= fromInteger i <= ord minBound
&& fromInteger i >= ord maxBound
litFitsInChar _ = False
-
--- | Finds a nominal size of a string literal. Every literal has size at least 1
-litSize :: Literal -> Int
--- Used by CoreUnfold.sizeExpr
-litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
- -- If size could be 0 then @f "x"@ might be too small
- -- [Sept03: make literal strings a bit bigger to avoid fruitless
- -- duplication of little strings]
-litSize _other = 1
\end{code}
Types
literalType (MachWord64 _) = word64PrimTy
literalType (MachFloat _) = floatPrimTy
literalType (MachDouble _) = doublePrimTy
-literalType (MachLabel _ _) = addrPrimTy
+literalType (MachLabel _ _ _) = addrPrimTy
+
+absentLiteralOf :: TyCon -> Maybe Literal
+-- Return a literal of the appropriate primtive
+-- TyCon, to use as a placeholder when it doesn't matter
+absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
+
+absent_lits :: UniqFM Literal
+absent_lits = listToUFM [ (addrPrimTyConKey, MachNullAddr)
+ , (charPrimTyConKey, MachChar 'x')
+ , (intPrimTyConKey, MachInt 0)
+ , (int64PrimTyConKey, MachInt64 0)
+ , (floatPrimTyConKey, MachFloat 0)
+ , (doublePrimTyConKey, MachDouble 0)
+ , (wordPrimTyConKey, MachWord 0)
+ , (word64PrimTyConKey, MachWord64 0) ]
\end{code}
cmpLit (MachWord64 a) (MachWord64 b) = a `compare` b
cmpLit (MachFloat a) (MachFloat b) = a `compare` b
cmpLit (MachDouble a) (MachDouble b) = a `compare` b
-cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
+cmpLit (MachLabel a _ _) (MachLabel b _ _) = a `compare` b
cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
| otherwise = GT
litTag (MachWord64 _) = _ILIT(7)
litTag (MachFloat _) = _ILIT(8)
litTag (MachDouble _) = _ILIT(9)
-litTag (MachLabel _ _) = _ILIT(10)
+litTag (MachLabel _ _ _) = _ILIT(10)
\end{code}
Printing
pprLit (MachFloat f) = ptext (sLit "__float") <+> rational f
pprLit (MachDouble d) = rational d
pprLit (MachNullAddr) = ptext (sLit "__NULL")
-pprLit (MachLabel l mb) = ptext (sLit "__label") <+>
- case mb of
- Nothing -> pprHsString l
- Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
+pprLit (MachLabel l mb fod) = ptext (sLit "__label") <+> b <+> ppr fod
+ where b = case mb of
+ Nothing -> pprHsString l
+ Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
pprIntVal :: Integer -> SDoc
-- ^ Print negative integers with parens to be sure it's unambiguous
hashLiteral (MachWord64 i) = hashInteger i
hashLiteral (MachFloat r) = hashRational r
hashLiteral (MachDouble r) = hashRational r
-hashLiteral (MachLabel s _) = hashFS s
+hashLiteral (MachLabel s _ _) = hashFS s
hashRational :: Rational -> Int
hashRational r = hashInteger (numerator r)
projects / ghc-hetmet.git / blobdiff