X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FLiteral.lhs;h=da8685e6b3f094ae51d141b6dbd787b9cba0b35a;hp=626f0cb8802835f510a714be60a45fbf6aea3f0c;hb=cbd7463c986d54422de15cb3b56184de116ef7ba;hpb=7c6c7a46655b93f6c85d3efb4bea5cb511d9353b diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs index 626f0cb..da8685e 100644 --- a/compiler/basicTypes/Literal.lhs +++ b/compiler/basicTypes/Literal.lhs @@ -11,6 +11,7 @@ -- any warnings in the module. See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details +{-# LANGUAGE DeriveDataTypeable #-} module Literal ( @@ -24,9 +25,9 @@ module Literal , mkMachChar, mkMachString -- ** Operations on Literals - , litSize , literalType , hashLiteral + , absentLiteralOf -- ** Predicates on Literals and their contents , litIsDupable, litIsTrivial @@ -44,47 +45,26 @@ module Literal ) 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} %* * %************************************************************************ @@ -121,14 +101,17 @@ data Literal | 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@ => @\@ will -- be appended to label name when emitting assembly. + deriving (Data, Typeable) \end{code} Binary instance @@ -144,7 +127,11 @@ instance Binary Literal where 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 @@ -177,7 +164,8 @@ instance Binary Literal where 9 -> do aj <- get bh mb <- get bh - return (MachLabel aj mb) + fod <- get bh + return (MachLabel aj mb fod) \end{code} \begin{code} @@ -324,15 +312,6 @@ litFitsInChar (MachInt i) = 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 @@ -349,7 +328,22 @@ literalType (MachInt64 _) = int64PrimTy 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} @@ -366,7 +360,7 @@ cmpLit (MachInt64 a) (MachInt64 b) = a `compare` b 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 @@ -380,7 +374,7 @@ litTag (MachInt64 _) = _ILIT(6) litTag (MachWord64 _) = _ILIT(7) litTag (MachFloat _) = _ILIT(8) litTag (MachDouble _) = _ILIT(9) -litTag (MachLabel _ _) = _ILIT(10) +litTag (MachLabel _ _ _) = _ILIT(10) \end{code} Printing @@ -399,10 +393,10 @@ pprLit (MachWord64 w) = ptext (sLit "__word64") <+> integer w 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 @@ -431,7 +425,7 @@ hashLiteral (MachWord i) = hashInteger i 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)