X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FLiteral.lhs;h=e83ea9db74e006ea9b6e9305f8678d7c648074e9;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=3781abefe95c3be766dfbf7ab1843728fab53021;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs index 3781abe..e83ea9d 100644 --- a/ghc/compiler/basicTypes/Literal.lhs +++ b/ghc/compiler/basicTypes/Literal.lhs @@ -7,14 +7,14 @@ module Literal ( Literal(..) -- Exported to ParseIface , mkMachInt, mkMachWord - , mkMachInt64, mkMachWord64 + , mkMachInt64, mkMachWord64, mkStringLit , litSize , litIsDupable, litIsTrivial - , literalType, literalPrimRep + , literalType , hashLiteral , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange - , isZeroLit, + , isZeroLit , word2IntLit, int2WordLit , narrow8IntLit, narrow16IntLit, narrow32IntLit @@ -29,10 +29,7 @@ module Literal import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy, intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy ) -import PrimRep ( PrimRep(..) ) import Type ( Type ) -import CStrings ( pprFSInCStyle ) - import Outputable import FastTypes import FastString @@ -96,8 +93,12 @@ function applications, etc., etc., has not yet been done. data Literal = ------------------ -- First the primitive guys - MachChar Int -- Char# At least 31 bits - | MachStr FastString + MachChar Char -- Char# At least 31 bits + + | MachStr FastString -- A string-literal: stored and emitted + -- UTF-8 encoded, we'll arrange to decode it + -- at runtime. Also emitted with a '\0' + -- terminator. | MachNullAddr -- the NULL pointer, the only pointer value -- that can be represented as a Literal. @@ -207,12 +208,15 @@ mkMachWord x = -- ASSERT2( inWordRange x, integer x ) mkMachInt64 x = MachInt64 x mkMachWord64 x = MachWord64 x +mkStringLit :: String -> Literal +mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded + inIntRange, inWordRange :: Integer -> Bool inIntRange x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT inWordRange x = x >= 0 && x <= tARGET_MAX_WORD -inCharRange :: Int -> Bool -inCharRange c = c >= 0 && c <= tARGET_MAX_CHAR +inCharRange :: Char -> Bool +inCharRange c = c >= '\0' && c <= chr tARGET_MAX_CHAR isZeroLit :: Literal -> Bool isZeroLit (MachInt 0) = True @@ -250,8 +254,8 @@ narrow8WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word8)) narrow16WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word16)) narrow32WordLit (MachWord w) = MachWord (toInteger (fromInteger w :: Word32)) -char2IntLit (MachChar c) = MachInt (toInteger c) -int2CharLit (MachInt i) = MachChar (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) @@ -298,31 +302,16 @@ litSize _other = 1 ~~~~~ \begin{code} literalType :: Literal -> Type -literalType (MachChar _) = charPrimTy -literalType (MachStr _) = addrPrimTy -literalType (MachNullAddr) = addrPrimTy -literalType (MachInt _) = intPrimTy -literalType (MachWord _) = wordPrimTy -literalType (MachInt64 _) = int64PrimTy -literalType (MachWord64 _) = word64PrimTy -literalType (MachFloat _) = floatPrimTy -literalType (MachDouble _) = doublePrimTy -literalType (MachLabel _ _) = addrPrimTy -\end{code} - -\begin{code} -literalPrimRep :: Literal -> PrimRep - -literalPrimRep (MachChar _) = CharRep -literalPrimRep (MachStr _) = AddrRep -- specifically: "char *" -literalPrimRep (MachNullAddr) = AddrRep -literalPrimRep (MachInt _) = IntRep -literalPrimRep (MachWord _) = WordRep -literalPrimRep (MachInt64 _) = Int64Rep -literalPrimRep (MachWord64 _) = Word64Rep -literalPrimRep (MachFloat _) = FloatRep -literalPrimRep (MachDouble _) = DoubleRep -literalPrimRep (MachLabel _ _) = AddrRep +literalType MachNullAddr = addrPrimTy +literalType (MachChar _) = charPrimTy +literalType (MachStr _) = addrPrimTy +literalType (MachInt _) = intPrimTy +literalType (MachWord _) = wordPrimTy +literalType (MachInt64 _) = int64PrimTy +literalType (MachWord64 _) = word64PrimTy +literalType (MachFloat _) = floatPrimTy +literalType (MachDouble _) = doublePrimTy +literalType (MachLabel _ _) = addrPrimTy \end{code} @@ -360,71 +349,24 @@ litTag (MachLabel _ _) = _ILIT(10) exceptions: MachFloat gets an initial keyword prefix. \begin{code} -pprLit lit - = getPprStyle $ \ sty -> - let - code_style = codeStyle sty - in - case lit of - MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show ch)] - | otherwise -> pprHsChar ch - - MachStr s | code_style -> pprFSInCStyle s - | otherwise -> pprHsString s - -- Warning: printing MachStr in code_style assumes it contains - -- only characters '\0'..'\xFF'! - - MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1") - -- Avoid a problem whereby gcc interprets - -- the constant minInt as unsigned. - | otherwise -> pprIntVal i - - MachInt64 i | code_style -> pprIntVal i -- Same problem with gcc??? - | otherwise -> ptext SLIT("__int64") <+> integer i - - MachWord w | code_style -> pprHexVal w - | otherwise -> ptext SLIT("__word") <+> integer w - - MachWord64 w | code_style -> pprHexVal w - | otherwise -> ptext SLIT("__word64") <+> integer w - - MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> code_rational f - | otherwise -> ptext SLIT("__float") <+> rational f - - MachDouble d | code_style -> code_rational d - | otherwise -> rational d - - MachNullAddr | code_style -> ptext SLIT("(void*)0") - | otherwise -> ptext SLIT("__NULL") - - MachLabel l mb - | code_style -> ptext SLIT("(&") <> ftext l <> char ')' - | otherwise -> ptext SLIT("__label") <+> - case mb of - Nothing -> pprHsString l - Just x -> doubleQuotes (text (unpackFS l ++ '@':show x)) - --- negative floating literals in code style need parentheses to avoid --- interacting with surrounding syntax. -code_rational d | d < 0 = parens (rational d) - | otherwise = rational d +pprLit (MachChar ch) = pprHsChar ch +pprLit (MachStr s) = pprHsString s +pprLit (MachInt i) = pprIntVal i +pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i +pprLit (MachWord w) = ptext SLIT("__word") <+> integer w +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)) pprIntVal :: Integer -> SDoc -- Print negative integers with parens to be sure it's unambiguous pprIntVal i | i < 0 = parens (integer i) | otherwise = integer i - -pprHexVal :: Integer -> SDoc --- Print in C hex format: 0x13fa -pprHexVal 0 = ptext SLIT("0x0") -pprHexVal w = ptext SLIT("0x") <> go w - where - go 0 = empty - go w = go quot <> dig - where - (quot,rem) = w `quotRem` 16 - dig | rem < 10 = char (chr (fromInteger rem + ord '0')) - | otherwise = char (chr (fromInteger rem - 10 + ord 'a')) \end{code} @@ -439,7 +381,7 @@ Hash values should be zero or a positive integer. No negatives please. \begin{code} hashLiteral :: Literal -> Int -hashLiteral (MachChar c) = c + 1000 -- Keep it out of range of common ints +hashLiteral (MachChar c) = ord c + 1000 -- Keep it out of range of common ints hashLiteral (MachStr s) = hashFS s hashLiteral (MachNullAddr) = 0 hashLiteral (MachInt i) = hashInteger i