projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Make TcUnify warning-free
[ghc-hetmet.git]
/
compiler
/
basicTypes
/
Literal.lhs
diff --git
a/compiler/basicTypes/Literal.lhs
b/compiler/basicTypes/Literal.lhs
index
e83ea9d
..
a3e307b
100644
(file)
--- a/
compiler/basicTypes/Literal.lhs
+++ b/
compiler/basicTypes/Literal.lhs
@@
-1,9
+1,17
@@
%
%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[Literal]{@Literal@: Machine literals (unboxed, of course)}
\begin{code}
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[Literal]{@Literal@: Machine literals (unboxed, of course)}
\begin{code}
+{-# 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/Commentary/CodingStyle#Warnings
+-- for details
+
module Literal
( Literal(..) -- Exported to ParseIface
, mkMachInt, mkMachWord
module Literal
( Literal(..) -- Exported to ParseIface
, mkMachInt, mkMachWord
@@
-15,6
+23,7
@@
module Literal
, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
, isZeroLit
, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
, isZeroLit
+ , litFitsInChar
, word2IntLit, int2WordLit
, narrow8IntLit, narrow16IntLit, narrow32IntLit
, word2IntLit, int2WordLit
, narrow8IntLit, narrow16IntLit, narrow32IntLit
@@
-24,26
+33,20
@@
module Literal
, nullAddrLit, float2DoubleLit, double2FloatLit
) where
, nullAddrLit, float2DoubleLit, double2FloatLit
) where
-#include "HsVersions.h"
-
-import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
- intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
- )
-import Type ( Type )
+import TysPrim
+import Type
import Outputable
import FastTypes
import FastString
import Binary
import Outputable
import FastTypes
import FastString
import Binary
+import Ratio
-import Ratio ( numerator )
-import FastString ( uniqueOfFS, lengthFS )
-import DATA_INT ( Int8, Int16, Int32 )
-import DATA_WORD ( Word8, Word16, Word32 )
-import Char ( ord, chr )
+import Data.Int
+import Data.Word
+import Data.Char
\end{code}
\end{code}
-
%************************************************************************
%* *
\subsection{Sizes}
%************************************************************************
%* *
\subsection{Sizes}
@@
-57,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
\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
tARGET_MIN_INT = toInteger (minBound :: Int)
tARGET_MAX_INT = toInteger (maxBound :: Int)
#else
@@
-225,7
+228,7
@@
isZeroLit (MachWord 0) = True
isZeroLit (MachWord64 0) = True
isZeroLit (MachFloat 0) = True
isZeroLit (MachDouble 0) = True
isZeroLit (MachWord64 0) = True
isZeroLit (MachFloat 0) = True
isZeroLit (MachDouble 0) = True
-isZeroLit other = False
+isZeroLit _ = False
\end{code}
Coercions
\end{code}
Coercions
@@
-278,14
+281,20
@@
litIsTrivial :: Literal -> Bool
-- c.f. CoreUtils.exprIsTrivial
-- False principally of strings
litIsTrivial (MachStr _) = False
-- 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 :: 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)
+ = fromInteger i <= ord minBound
+ && fromInteger i >= ord maxBound
+litFitsInChar _ = False
litSize :: Literal -> Int
-- Used by CoreUnfold.sizeExpr
litSize :: Literal -> Int
-- Used by CoreUnfold.sizeExpr
@@
-318,6
+327,7
@@
literalType (MachLabel _ _) = addrPrimTy
Comparison
~~~~~~~~~~
\begin{code}
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
cmpLit (MachChar a) (MachChar b) = a `compare` b
cmpLit (MachStr a) (MachStr b) = a `compare` b
cmpLit (MachNullAddr) (MachNullAddr) = EQ
@@
-331,6
+341,7
@@
cmpLit (MachLabel a _) (MachLabel b _) = a `compare` b
cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
| otherwise = GT
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)
litTag (MachChar _) = _ILIT(1)
litTag (MachStr _) = _ILIT(2)
litTag (MachNullAddr) = _ILIT(3)
@@
-349,16
+360,17
@@
litTag (MachLabel _ _) = _ILIT(10)
exceptions: MachFloat gets an initial keyword prefix.
\begin{code}
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 (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 (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))
case mb of
Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))