X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FLiteral.lhs;h=a3e307bbc19e47f31928c2a321165a7d6d0a3c64;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=aef61ea0d43dbb5425778806cabd62edd0352d35;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs index aef61ea..a3e307b 100644 --- a/compiler/basicTypes/Literal.lhs +++ b/compiler/basicTypes/Literal.lhs @@ -5,11 +5,11 @@ \section[Literal]{@Literal@: Machine literals (unboxed, of course)} \begin{code} -{-# OPTIONS_GHC -w #-} +{-# OPTIONS -fno-warn-incomplete-patterns #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module Literal @@ -33,8 +33,6 @@ module Literal , nullAddrLit, float2DoubleLit, double2FloatLit ) where -#include "HsVersions.h" - import TysPrim import Type import Outputable @@ -62,7 +60,7 @@ respectively (which will be wrong on a 64-bit machine). \begin{code} tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer -#if __GLASGOW_HASKELL__ +#ifdef __GLASGOW_HASKELL__ tARGET_MIN_INT = toInteger (minBound :: Int) tARGET_MAX_INT = toInteger (maxBound :: Int) #else @@ -230,7 +228,7 @@ isZeroLit (MachWord 0) = True isZeroLit (MachWord64 0) = True isZeroLit (MachFloat 0) = True isZeroLit (MachDouble 0) = True -isZeroLit other = False +isZeroLit _ = False \end{code} Coercions @@ -283,14 +281,14 @@ litIsTrivial :: Literal -> Bool -- c.f. CoreUtils.exprIsTrivial -- False principally of strings litIsTrivial (MachStr _) = False -litIsTrivial other = True +litIsTrivial _ = True litIsDupable :: Literal -> Bool -- True if code space does not go bad if we duplicate this literal -- c.f. CoreUtils.exprIsDupable -- Currently we treat it just like litIsTrivial litIsDupable (MachStr _) = False -litIsDupable other = True +litIsDupable _ = True litFitsInChar :: Literal -> Bool litFitsInChar (MachInt i) @@ -329,6 +327,7 @@ literalType (MachLabel _ _) = addrPrimTy Comparison ~~~~~~~~~~ \begin{code} +cmpLit :: Literal -> Literal -> Ordering cmpLit (MachChar a) (MachChar b) = a `compare` b cmpLit (MachStr a) (MachStr b) = a `compare` b cmpLit (MachNullAddr) (MachNullAddr) = EQ @@ -342,6 +341,7 @@ cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT | otherwise = GT +litTag :: Literal -> FastInt litTag (MachChar _) = _ILIT(1) litTag (MachStr _) = _ILIT(2) litTag (MachNullAddr) = _ILIT(3) @@ -360,16 +360,17 @@ litTag (MachLabel _ _) = _ILIT(10) exceptions: MachFloat gets an initial keyword prefix. \begin{code} +pprLit :: Literal -> SDoc 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 (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") <+> +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))