\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
import Ratio ( numerator, denominator )
import FastString ( uniqueOfFS )
import Char ( ord, chr )
-
-#if __GLASGOW_HASKELL__ >= 404
-import GlaExts ( fromInt )
-#endif
\end{code}
| 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}
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)
| 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
\begin{code}
isLitLitLit (MachLitLit _ _) = True
isLitLitLit _ = False
+
+maybeLitLit (MachLitLit s t) = Just (s,t)
+maybeLitLit _ = Nothing
\end{code}
Types
literalType (MachWord64 _) = word64PrimTy
literalType (MachFloat _) = floatPrimTy
literalType (MachDouble _) = doublePrimTy
+literalType (MachLabel _) = addrPrimTy
literalType (MachLitLit _ ty) = ty
\end{code}
literalPrimRep (MachWord64 _) = Word64Rep
literalPrimRep (MachFloat _) = FloatRep
literalPrimRep (MachDouble _) = DoubleRep
+literalPrimRep (MachLabel _) = AddrRep
literalPrimRep (MachLitLit _ ty) = typePrimRep ty
\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 (MachLitLit a b) (MachLitLit c d) = (a `compare` c) `thenCmp` (b `compare` d)
cmpLit lit1 lit2 | litTag lit1 _LT_ litTag lit2 = LT
| otherwise = GT
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
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
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
projects / ghc-hetmet.git / blobdiff