X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FLiteral.lhs;h=54af4732d8f437d665b20c035e0cc1daf4ffee10;hb=5d42ac16b2e956c03455a1f8328d876b670d3635;hp=fe8ab73ba2e4a81648ab193cc40d013df2436ccd;hpb=9ad1b1c5866d0efb6ec32b33adacbfb5091d5cf3;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs index fe8ab73..54af473 100644 --- a/ghc/compiler/basicTypes/Literal.lhs +++ b/ghc/compiler/basicTypes/Literal.lhs @@ -4,31 +4,29 @@ \section[Literal]{@Literal@: Machine literals (unboxed, of course)} \begin{code} -module Literal ( - Literal(..), -- Exported to ParseIface - mkMachInt, mkMachWord, - mkMachInt64, mkMachWord64, - isLitLitLit, - literalType, literalPrimRep, - hashLiteral, +module Literal + ( Literal(..) -- Exported to ParseIface + , mkMachInt, mkMachWord + , mkMachInt64, mkMachWord64 + , isLitLitLit, maybeLitLit + , literalType, literalPrimRep + , hashLiteral - inIntRange, inWordRange, + , inIntRange, inWordRange, tARGET_MAX_INT - word2IntLit, int2WordLit, int2CharLit, - int2FloatLit, int2DoubleLit, char2IntLit - ) where + , word2IntLit, int2WordLit, char2IntLit, int2CharLit + , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit + , addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit + ) where #include "HsVersions.h" import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy, intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy ) -import Name ( hashName ) import PrimRep ( PrimRep(..) ) -import TyCon ( isNewTyCon ) import Type ( Type, typePrimRep ) import PprType ( pprParendType ) -import Demand ( Demand ) import CStrings ( charToC, charToEasyHaskell, pprFSInCStyle ) import Outputable @@ -37,10 +35,6 @@ import Util ( thenCmp ) import Ratio ( numerator, denominator ) import FastString ( uniqueOfFS ) import Char ( ord, chr ) - -#if __GLASGOW_HASKELL__ >= 404 -import GlaExts ( fromInt ) -#endif \end{code} @@ -104,7 +98,15 @@ data Literal | MachFloat Rational | MachDouble Rational - | MachLitLit FAST_STRING Type -- Type might be Add# or Int# etc + -- string argument is the name of a symbol. This literal + -- refers to the *address* of the label. + | MachLabel FAST_STRING -- always an Addr# + + -- lit-lits only work for via-C compilation, hence they + -- are deprecated. The string is emitted verbatim into + -- the C file, and can therefore be any C expression, + -- macro call, #defined constant etc. + | MachLitLit FAST_STRING Type -- Type might be Addr# or Int# etc \end{code} \begin{code} @@ -145,8 +147,9 @@ inWordRange x = x >= 0 && x <= tARGET_MAX_WORD Coercions ~~~~~~~~~ \begin{code} -word2IntLit, int2WordLit, int2CharLit, char2IntLit :: Literal -> Literal -int2FloatLit, int2DoubleLit :: Literal -> Literal +word2IntLit, int2WordLit, char2IntLit, int2CharLit, + float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit, + addr2IntLit, int2AddrLit, float2DoubleLit, double2FloatLit :: Literal -> Literal word2IntLit (MachWord w) | w > tARGET_MAX_INT = MachInt ((-1) + tARGET_MAX_WORD - w) @@ -156,11 +159,20 @@ int2WordLit (MachInt i) | i < 0 = MachWord (1 + tARGET_MAX_WORD + i) -- (-1) ---> tARGET_MAX_WORD | otherwise = MachWord i -int2CharLit (MachInt i) = MachChar (chr (fromInteger i)) char2IntLit (MachChar c) = MachInt (toInteger (ord c)) +int2CharLit (MachInt i) = MachChar (chr (fromInteger i)) + +float2IntLit (MachFloat f) = MachInt (truncate f) +int2FloatLit (MachInt i) = MachFloat (fromInteger i) -int2FloatLit (MachInt i) = MachFloat (fromInteger i) -int2DoubleLit (MachInt i) = MachDouble (fromInteger i) +double2IntLit (MachFloat f) = MachInt (truncate f) +int2DoubleLit (MachInt i) = MachDouble (fromInteger i) + +addr2IntLit (MachAddr a) = MachInt a +int2AddrLit (MachInt i) = MachAddr i + +float2DoubleLit (MachFloat f) = MachDouble f +double2FloatLit (MachDouble d) = MachFloat d \end{code} Predicates @@ -168,6 +180,9 @@ int2DoubleLit (MachInt i) = MachDouble (fromInteger i) \begin{code} isLitLitLit (MachLitLit _ _) = True isLitLitLit _ = False + +maybeLitLit (MachLitLit s t) = Just (s,t) +maybeLitLit _ = Nothing \end{code} Types @@ -183,6 +198,7 @@ literalType (MachInt64 _) = int64PrimTy literalType (MachWord64 _) = word64PrimTy literalType (MachFloat _) = floatPrimTy literalType (MachDouble _) = doublePrimTy +literalType (MachLabel _) = addrPrimTy literalType (MachLitLit _ ty) = ty \end{code} @@ -198,6 +214,7 @@ literalPrimRep (MachInt64 _) = Int64Rep literalPrimRep (MachWord64 _) = Word64Rep literalPrimRep (MachFloat _) = FloatRep literalPrimRep (MachDouble _) = DoubleRep +literalPrimRep (MachLabel _) = AddrRep literalPrimRep (MachLitLit _ ty) = typePrimRep ty \end{code} @@ -214,6 +231,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 (MachLitLit a b) (MachLitLit c d) = (a `compare` c) `thenCmp` (b `compare` d) cmpLit lit1 lit2 | litTag lit1 _LT_ litTag lit2 = LT | otherwise = GT @@ -227,7 +245,8 @@ litTag (MachInt64 _) = ILIT(6) litTag (MachWord64 _) = ILIT(7) litTag (MachFloat _) = ILIT(8) litTag (MachDouble _) = ILIT(9) -litTag (MachLitLit _ _) = ILIT(10) +litTag (MachLabel _) = ILIT(10) +litTag (MachLitLit _ _) = ILIT(11) \end{code} Printing @@ -239,13 +258,14 @@ litTag (MachLitLit _ _) = ILIT(10) pprLit lit = getPprStyle $ \ sty -> let - code_style = codeStyle sty + code_style = codeStyle sty + iface_style = ifaceStyle sty in case lit of - MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), char '\'', - text (charToC ch), char '\''] - | ifaceStyle sty -> char '\'' <> text (charToEasyHaskell ch) <> char '\'' - | otherwise -> text ['\'', ch, '\''] + MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), char '\'', + text (charToC ch), char '\''] + | iface_style -> char '\'' <> text (charToEasyHaskell ch) <> char '\'' + | otherwise -> text ['\'', ch, '\''] MachStr s | code_style -> pprFSInCStyle s | otherwise -> pprFSAsString s @@ -267,16 +287,19 @@ pprLit lit MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> rational f | otherwise -> ptext SLIT("__float") <+> rational f - MachDouble d | ifaceStyle sty && d < 0 -> parens (rational d) - | otherwise -> rational d + MachDouble d | iface_style && d < 0 -> parens (rational d) + | otherwise -> rational d MachAddr p | code_style -> ptext SLIT("(void*)") <> integer p | otherwise -> ptext SLIT("__addr") <+> integer p - MachLitLit s ty | code_style -> ptext s - | otherwise -> parens (hsep [ptext SLIT("__litlit"), - pprFSAsString s, - pprParendType ty]) + MachLabel l | code_style -> ptext SLIT("(&") <> ptext l <> char ')' + | otherwise -> ptext SLIT("__label") <+> pprFSAsString l + + MachLitLit s ty | code_style -> ptext s + | otherwise -> parens (hsep [ptext SLIT("__litlit"), + pprFSAsString s, + pprParendType ty]) pprIntVal :: Integer -> SDoc -- Print negative integers with parens to be sure it's unambiguous